mirror of
https://github.com/moparisthebest/Simba
synced 2024-08-13 16:53:59 -04:00
Tried to got DTM editor working as extension, but it still needs a lot of work.
This commit is contained in:
Niels
parent
363e7d394f
commit
0acdef9d72
1349
Extensions/dtm_editor.sex
Normal file
1349
Extensions/dtm_editor.sex
Normal file
File diff suppressed because it is too large
Load Diff
@ -370,7 +370,7 @@ begin
|
||||
end;
|
||||
|
||||
if (Data <> nil) then //If showing automatically
|
||||
if (s <> '') and (((mp.DeclarationAtPos <> nil) and (mp.DeclarationAtPos is TciCompoundStatement)) or ((mp.DeclarationAtPos.Owner <> nil) and (mp.DeclarationAtPos.Owner is TciCompoundStatement))) then
|
||||
if (s <> '') and ((mp.DeclarationAtPos <> nil) and ((mp.DeclarationAtPos is TciCompoundStatement) or mp.DeclarationAtPos.HasOwnerClass(TciCompoundStatement, d, True))) then
|
||||
Data := nil;
|
||||
|
||||
if (Data = nil) then
|
||||
|
||||
@ -5,8 +5,9 @@ unit psextension;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,mufasabase, virtualextension, MufasaTypes,
|
||||
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor,forms;
|
||||
Classes, SysUtils, virtualextension, forms, client, uPSComponent,uPSCompiler,
|
||||
uPSRuntime, stdCtrls, uPSPreProcessor,MufasaTypes,MufasaBase, web,
|
||||
bitmaps, plugins, libloader, dynlibs,internets,scriptproperties, settingssandbox;
|
||||
|
||||
|
||||
|
||||
@ -35,7 +36,7 @@ type
|
||||
protected
|
||||
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
||||
procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
|
||||
procedure RegisterMyMethods(Sender: TPSScript);
|
||||
procedure RegisterMyMethods(x: TPSScript);
|
||||
procedure OnPSExecute(Sender: TPSScript);
|
||||
procedure SetEnabled(bool : boolean);override;
|
||||
end;
|
||||
@ -43,12 +44,48 @@ type
|
||||
|
||||
implementation
|
||||
uses
|
||||
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms,
|
||||
uPSC_extctrls,uPSC_menus, uPSC_mml, //Compile libs
|
||||
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
|
||||
uPSR_extctrls,uPSR_menus, uPSR_mml, //Runtime-libs
|
||||
SimbaUnit,updateform,settingssandbox,bitmaps,files,Dialogs, mmisc//Writeln
|
||||
;
|
||||
colour_conv,dtmutil,
|
||||
{$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds
|
||||
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, uPSC_menus,
|
||||
uPSC_extctrls, uPSC_mml, //Compile-libs
|
||||
uPSUtils,
|
||||
fontloader,
|
||||
IOmanager,//TTarget_Exported
|
||||
IniFiles,//Silly INI files
|
||||
stringutil, //String st00f
|
||||
|
||||
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_mml,
|
||||
uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs,
|
||||
files,
|
||||
dialogs,
|
||||
dtm, //Dtms!
|
||||
uPSR_extctrls, //Runtime-libs
|
||||
Graphics, //For Graphics types
|
||||
math, //Maths!
|
||||
mmath, //Real maths!
|
||||
strutils,
|
||||
fileutil,
|
||||
tpa, //Tpa stuff
|
||||
SynRegExpr,
|
||||
lclintf,
|
||||
SimbaUnit,updateform, mmisc, mmlpsthread; // for GetTickCount and others.//Writeln
|
||||
|
||||
{$ifdef Linux}
|
||||
{$define PS_SafeCall}
|
||||
{$else}
|
||||
//{$define PS_SafeCall}
|
||||
{$endif}
|
||||
{$MACRO ON}
|
||||
{$ifdef PS_SafeCall}
|
||||
{$define extdecl := safecall}
|
||||
{$else}
|
||||
{$define extdecl := register}
|
||||
{$endif}
|
||||
|
||||
procedure psWriteLn(s: string);
|
||||
begin
|
||||
formWritelnEx(s);
|
||||
end;
|
||||
|
||||
function TSimbaPSExtension.HookExists(const HookName: String): Boolean;
|
||||
begin
|
||||
@ -68,7 +105,7 @@ begin
|
||||
result := SExt_ok;
|
||||
except
|
||||
on e : exception do
|
||||
formWritelnEx(format('Error in Simba extension (%s): %s',[Self.GetName,e.message]));
|
||||
//formWritelnEx(format('Error in Simba extension (%s): %s',[Self.GetName,e.message]));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -111,35 +148,63 @@ begin
|
||||
result := ExecuteHook('Free',Args,bla) = SExt_ok;
|
||||
end;
|
||||
|
||||
{$I ../../Units/MMLAddon/PSInc/Wrappers/extensions.inc}
|
||||
{$DEFINE MML_EXPORT_THREADSAFE}
|
||||
{$I Wrappers/other.inc}
|
||||
{$I Wrappers/settings.inc}
|
||||
{$I Wrappers/bitmap.inc}
|
||||
{$I Wrappers/window.inc}
|
||||
{$I Wrappers/tpa.inc}
|
||||
{$I Wrappers/strings.inc}
|
||||
{$I Wrappers/colour.inc}
|
||||
{$I Wrappers/colourconv.inc}
|
||||
{$I Wrappers/math.inc}
|
||||
{$I Wrappers/mouse.inc}
|
||||
{$I Wrappers/file.inc}
|
||||
{$I Wrappers/keyboard.inc}
|
||||
{$I Wrappers/dtm.inc}
|
||||
{$I Wrappers/ocr.inc}
|
||||
{$I Wrappers/internets.inc}
|
||||
{$I Wrappers/extensions.inc}
|
||||
|
||||
procedure TSimbaPSExtension.RegisterMyMethods(Sender: TPSScript);
|
||||
procedure TSimbaPSExtension.RegisterMyMethods(x: TPSScript);
|
||||
|
||||
procedure SetCurrSection(s: string);
|
||||
begin
|
||||
end;
|
||||
|
||||
var
|
||||
AppPath, ScriptPath: string;
|
||||
i: Integer;
|
||||
begin
|
||||
Sender.Comp.AddTypes('TStringArray','Array of String');
|
||||
Sender.Comp.AddConstantN('AppPath','string').SetString(MainDir + DirectorySeparator);
|
||||
Sender.Comp.AddConstantN('IncludePath','string').SetString(SimbaForm.IncludePath);
|
||||
Sender.Comp.AddConstantN('PluginPath','string').SetString(SimbaForm.PluginPath);
|
||||
Sender.Comp.AddConstantN('FontPath','string').SetString(SimbaForm.FontPath);
|
||||
Sender.Comp.AddConstantN('ExtPath','string').SetString(SimbaForm.ExtPath);
|
||||
Sender.Comp.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmati'
|
||||
+'on, mtCustom )');
|
||||
Sender.Comp.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m'
|
||||
+'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
|
||||
Sender.Comp.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
|
||||
Sender.AddFunction(@formWritelnEx,'procedure Writeln(s : string)');
|
||||
Sender.AddFunction(@ext_GetPage,'function GetPage(const url : string) : string');
|
||||
Sender.AddFunction(@ext_DecompressBZip2,'function DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean;');
|
||||
Sender.AddFunction(@ext_UnTar,'function UnTar(const Input : string; out Content : TStringArray) : boolean;');
|
||||
Sender.AddFunction(@ext_UnTarEx,'function UnTarEx(const Input : string;const outputdir : string; overwrite : boolean): boolean;');
|
||||
Sender.AddFunction(@DirectoryExists,'Function DirectoryExists (Const Directory : String) : Boolean;');
|
||||
Sender.AddFunction(@FileExists,'Function FileExists (Const FileName : String) : Boolean;');
|
||||
Sender.AddFunction(@ForceDirectories,'function ForceDirectories(Const Dir: string): Boolean;');
|
||||
Sender.AddFunction(@GetFiles, 'function GetFiles(Path, Ext: string): TStringArray;');
|
||||
Sender.AddFunction(@GetDirectories,'function GetDirectories(Path: string): TstringArray;');
|
||||
Sender.AddFunction(@ext_MessageDlg,'function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;');
|
||||
Sender.AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox');
|
||||
Sender.AddRegisteredVariable('Simba','TForm');
|
||||
Sender.AddRegisteredVariable('Simba_MainMenu','TMainMenu');
|
||||
AppPath := MainDir + DirectorySeparator;
|
||||
ScriptPath := ExtractFileDir(Filename);
|
||||
|
||||
with SimbaForm, x do
|
||||
begin
|
||||
with Comp do
|
||||
begin
|
||||
{$I ../../Units/MMLAddon/PSInc/pscompile.inc}
|
||||
AddTypes('TStringArray','Array of String');
|
||||
AddConstantN('ExtPath','string').SetString(ExtPath);
|
||||
AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmation, mtCustom )');
|
||||
AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
|
||||
AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
|
||||
|
||||
for i := 0 to high(VirtualKeys) do
|
||||
AddConstantN(Format('VK_%S',[VirtualKeys[i].Str]),'Byte').SetInt(VirtualKeys[i].Key);
|
||||
end;
|
||||
|
||||
{$i ../../Units/MMLAddon/PSInc/psexportedmethods.inc}
|
||||
|
||||
AddFunction(@ext_GetPage,'function GetPage(const url : string) : string');
|
||||
AddFunction(@ext_DecompressBZip2,'function DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean;');
|
||||
AddFunction(@ext_UnTar,'function UnTar(const Input : string; out Content : TStringArray) : boolean;');
|
||||
AddFunction(@ext_UnTarEx,'function UnTarEx(const Input : string;const outputdir : string; overwrite : boolean): boolean;');
|
||||
AddFunction(@ext_MessageDlg,'function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;');
|
||||
AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox');
|
||||
AddRegisteredVariable('Simba','TForm');
|
||||
AddRegisteredVariable('Simba_MainMenu','TMainMenu');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSimbaPSExtension.OnPSExecute(Sender: TPSScript);
|
||||
@ -183,14 +248,42 @@ end;
|
||||
procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
||||
begin
|
||||
SIRegister_Std(x);
|
||||
SIRegister_Classes(x, True);
|
||||
SIRegister_Controls(x);
|
||||
SIRegister_Graphics(x, True);
|
||||
SIRegister_Classes(x, true);
|
||||
SIRegister_Graphics(x, true);
|
||||
SIRegister_stdctrls(x);
|
||||
SIRegister_Forms(x);
|
||||
SIRegister_ExtCtrls(x);
|
||||
SIRegister_Menus(x);
|
||||
SIRegister_ComCtrls(x);
|
||||
SIRegister_Dialogs(x);
|
||||
SIRegister_MML(x);
|
||||
|
||||
with x.AddFunction('procedure writeln;').decl do
|
||||
with AddParam do
|
||||
begin
|
||||
OrgName:= 'x';
|
||||
Mode:= pmIn;
|
||||
end;
|
||||
with x.AddFunction('function ToStr:string').decl do
|
||||
with addparam do
|
||||
begin
|
||||
OrgName:= 'x';
|
||||
Mode:= pmIn;
|
||||
end;
|
||||
with x.AddFunction('procedure swap;').decl do
|
||||
begin
|
||||
with addparam do
|
||||
begin
|
||||
OrgName:= 'x';
|
||||
Mode:= pmInOut;
|
||||
end;
|
||||
with addparam do
|
||||
begin
|
||||
OrgName:= 'y';
|
||||
Mode:= pmInOut;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSimbaPSExtension.RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
|
||||
@ -203,9 +296,17 @@ begin
|
||||
RIRegister_Forms(x);
|
||||
RIRegister_ExtCtrls(x);
|
||||
RIRegister_Menus(x);
|
||||
RIRegister_ComCtrls(x);
|
||||
RIRegister_Dialogs(x);
|
||||
RIRegister_MML(x);
|
||||
with x.FindClass('TMufasaBitmap') do
|
||||
begin
|
||||
RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'CopyClientToBitmap');
|
||||
end;
|
||||
|
||||
se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil);
|
||||
se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil);
|
||||
se.RegisterFunctionName('SWAP',@swap_,nil,nil);
|
||||
end;
|
||||
|
||||
destructor TSimbaPSExtension.Destroy;
|
||||
@ -223,6 +324,11 @@ begin
|
||||
{ Create script, and see if the extension is valid. (If it compiles) }
|
||||
PSInstance := TPSScript.Create(nil);
|
||||
|
||||
with PSInstance do
|
||||
begin
|
||||
{$I ../../Units/MMLAddon/PSInc/psdefines.inc}
|
||||
end;
|
||||
|
||||
PSInstance.Script := Self.Script;
|
||||
PSInstance.OnCompImport:=@RegisterPSCComponents;
|
||||
PSInstance.OnExecImport:=@RegisterPSRComponents;
|
||||
|
||||
@ -21,10 +21,6 @@
|
||||
Mouse.inc for the Mufasa Macro Library
|
||||
}
|
||||
|
||||
const
|
||||
ps_mouse_right = 0;
|
||||
ps_mouse_left = 1;
|
||||
ps_mouse_middle = 2;
|
||||
procedure ps_MoveMouse(x, y: integer); extdecl;
|
||||
begin
|
||||
CurrThread.Client.IOManager.MoveMouse(X, Y);
|
||||
|
||||
@ -21,6 +21,56 @@
|
||||
Other.inc for the Mufasa Macro Library
|
||||
}
|
||||
|
||||
function MakeString(data : TPSVariantIFC) : string;
|
||||
begin;
|
||||
if data.Dta = nil then
|
||||
result := 'Nil'
|
||||
else
|
||||
if data.aType.basetype in [btString,btChar] then
|
||||
result := PSGetAnsiString(Data.Dta,data.aType)
|
||||
else if data.aType.ExportName = 'BOOLEAN' then
|
||||
result := BoolToStr(PSGetInt(Data.Dta,data.aType) <> 0,true)
|
||||
else
|
||||
result := PSVariantToString(data,'');
|
||||
end;
|
||||
|
||||
function writeln_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
begin
|
||||
Result:=true;
|
||||
psWriteln(makeString(NewTPSVariantIFC(Stack[Stack.Count-1],false)));
|
||||
end;
|
||||
|
||||
function swap_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
var
|
||||
Param1,Param2: TPSVariantIFC;
|
||||
tempCopy : pointer;
|
||||
begin
|
||||
Result:=true;
|
||||
Param1 := NewTPSVariantIFC(Stack[Stack.count-1],true);
|
||||
Param2 := NewTPSVariantIFC(Stack[Stack.count-2],true);
|
||||
if Param1.aType.BaseType <> Param2.aType.BaseType then
|
||||
exit(false)
|
||||
else
|
||||
begin
|
||||
Param1.aType.CalcSize;
|
||||
param2.aType.CalcSize;
|
||||
if Param1.aType.RealSize <> Param2.aType.RealSize then
|
||||
exit(false);
|
||||
GetMem(tempcopy,Param1.aType.RealSize);
|
||||
Move(Param1.Dta^,tempCopy^,param1.atype.realsize);
|
||||
Move(Param2.Dta^,Param1.Dta^,param1.atype.realsize);
|
||||
Move(tempCopy^,Param2.Dta^,param1.atype.realsize);
|
||||
Freemem(tempcopy);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ToStr_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
begin
|
||||
result := true;
|
||||
Stack.SetAnsiString(-1, MakeString(NewTPSVariantIFC(Stack[Stack.Count-2],false)));
|
||||
end;
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
function ps_SetScriptProp(prop : TSP_Property; Value: TVariantArray): boolean; extdecl;
|
||||
begin
|
||||
Exit(CurrThread.Prop.SetProp(prop, Value));
|
||||
@ -30,6 +80,7 @@ function ps_GetScriptProp(prop : TSP_Property; var Value : TVariantArray) : bool
|
||||
begin;
|
||||
exit(CurrThread.Prop.GetProp(prop,value));
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure ps_Wait(t: Integer); extdecl;
|
||||
{$ifdef MSWINDOWS}
|
||||
@ -70,6 +121,7 @@ begin
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
procedure ps_ClearDebug; extdecl;
|
||||
begin
|
||||
if Assigned(CurrThread.DebugClear) then
|
||||
@ -122,6 +174,7 @@ function ps_GetTimeRunning: LongWord; extdecl;
|
||||
begin;
|
||||
result := GetTickCount - CurrThread.StartTime;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure ps_ConvertTime(Time : integer; var h,m,s : integer); extdecl;
|
||||
var
|
||||
@ -174,6 +227,7 @@ begin
|
||||
result := Random(int);
|
||||
end;
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
function ps_InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;extdecl;
|
||||
begin
|
||||
CurrThread.InputQueryData.ACaption:= ACaption;
|
||||
@ -183,3 +237,4 @@ begin
|
||||
Value := CurrThread.InputQueryData.Value;
|
||||
result := CurrThread.InputQueryData.Res;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
@ -21,47 +21,46 @@
|
||||
PSCompile.inc for the Mufasa Macro Library
|
||||
}
|
||||
|
||||
x.AddConstantN('AppPath','string').SetString(Self.AppPath);
|
||||
x.AddConstantN('ScriptPath','string').SetString(Self.ScriptPath);
|
||||
x.AddConstantN('IncludePath','string').SetString(Self.IncludePath);
|
||||
x.AddConstantN('PluginPath','string').SetString(Self.PluginPath);
|
||||
x.AddConstantN('FontPath','string').SetString(Self.FontPath);
|
||||
x.AddConstantN('MaxLongInt','integer').SetInt(maxLongint);
|
||||
x.AddConstantN('MaxInt','integer').SetInt(maxLongint);
|
||||
x.AddTypeS('TReplaceFlag', '(rfReplaceAll, rfIgnoreCase)');
|
||||
x.AddTypeS('TReplaceFlags','set of TReplaceFlag');
|
||||
x.AddTypeS('StrExtr','(Numbers, Letters, Others);');
|
||||
x.AddTypeS('TDateTime','Double');
|
||||
x.AddTypeS('TIntegerArray', 'Array of LongInt');
|
||||
x.AddTypeS('TByteArray','Array of byte');
|
||||
x.AddTypeS('TExtendedArray','Array of extended');
|
||||
x.AddTypeS('TBoolArray', 'Array of Boolean');
|
||||
x.AddTypes('TBox', 'record X1,Y1,X2,Y2 : Integer; end;');
|
||||
x.AddTypeS('TBoxArray','Array of TBox');
|
||||
x.AddTypeS('TPointArray','Array of TPoint');
|
||||
x.AddTypeS('T2DPointArray','Array of TPointArray');
|
||||
x.AddTypeS('TPointArrayArray','Array of TPointArray');
|
||||
x.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
|
||||
x.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
|
||||
x.addtypeS('PPoint','record R,T : extended; end;');
|
||||
x.AddTypeS('TTarget_Exported','record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15,int16:integer; end;');
|
||||
AddConstantN('AppPath','string').SetString(AppPath);
|
||||
AddConstantN('ScriptPath','string').SetString(ScriptPath);
|
||||
AddConstantN('IncludePath','string').SetString(IncludePath);
|
||||
AddConstantN('PluginPath','string').SetString(PluginPath);
|
||||
AddConstantN('FontPath','string').SetString(FontPath);
|
||||
AddConstantN('MaxLongInt','integer').SetInt(maxLongint);
|
||||
AddConstantN('MaxInt','integer').SetInt(maxLongint);
|
||||
AddTypeS('TReplaceFlag', '(rfReplaceAll, rfIgnoreCase)');
|
||||
AddTypeS('TReplaceFlags','set of TReplaceFlag');
|
||||
AddTypeS('StrExtr','(Numbers, Letters, Others);');
|
||||
AddTypeS('TDateTime','Double');
|
||||
AddTypeS('TIntegerArray', 'Array of LongInt');
|
||||
AddTypeS('TByteArray','Array of byte');
|
||||
AddTypeS('TExtendedArray','Array of extended');
|
||||
AddTypeS('TBoolArray', 'Array of Boolean');
|
||||
AddTypes('TBox', 'record X1,Y1,X2,Y2 : Integer; end;');
|
||||
AddTypeS('TBoxArray','Array of TBox');
|
||||
AddTypeS('TPointArray','Array of TPoint');
|
||||
AddTypeS('T2DPointArray','Array of TPointArray');
|
||||
AddTypeS('TPointArrayArray','Array of TPointArray');
|
||||
AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
|
||||
AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
|
||||
addtypeS('PPoint','record R,T : extended; end;');
|
||||
AddTypeS('TTarget_Exported','record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15,int16:integer; end;');
|
||||
|
||||
x.AddTypes('TSDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
|
||||
x.AddTypes('TSDTMPointDefArray', 'Array Of TSDTMPointDef;');
|
||||
x.AddTypes('TSDTM','record MainPoint: TSDTMPointDef; SubPoints: TSDTMPointDefArray; end;');
|
||||
x.AddTypes('TMDTMPoint','record x,y,c,t,asz : integer; bp : boolean; end;');
|
||||
x.AddTypes('TMDTMPointArray','array of TMDTMPoint;');
|
||||
AddTypes('TSDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
|
||||
AddTypes('TSDTMPointDefArray', 'Array Of TSDTMPointDef;');
|
||||
AddTypes('TSDTM','record MainPoint: TSDTMPointDef; SubPoints: TSDTMPointDefArray; end;');
|
||||
AddTypes('TMDTMPoint','record x,y,c,t,asz : integer; bp : boolean; end;');
|
||||
AddTypes('TMDTMPointArray','array of TMDTMPoint;');
|
||||
|
||||
x.AddTypeS('T2DExtendedArray', 'array of array of extended;');
|
||||
x.AddTypeS('T3DExtendedArray','array of array of array of extended;');
|
||||
x.AddTypeS('T2DIntegerArray','array of array of integer;');
|
||||
x.AddTypeS('TStringArray','Array of string;');
|
||||
x.AddTypeS('TMousePress', '(mouse_Down, mouse_Up);');
|
||||
x.AddTypeS('Pointer', 'Integer');
|
||||
AddTypeS('T2DExtendedArray', 'array of array of extended;');
|
||||
AddTypeS('T3DExtendedArray','array of array of array of extended;');
|
||||
AddTypeS('T2DIntegerArray','array of array of integer;');
|
||||
AddTypeS('TStringArray','Array of string;');
|
||||
AddTypeS('TMousePress', '(mouse_Down, mouse_Up);');
|
||||
AddTypeS('Pointer', 'Integer');
|
||||
|
||||
x.AddTypeS('TSP_Property','(SP_WriteTimeStamp,SP_OnTerminate)');
|
||||
AddTypeS('TSP_Property','(SP_WriteTimeStamp,SP_OnTerminate)');
|
||||
|
||||
|
||||
x.AddConstantN('mouse_Right','integer').SetInt(ps_mouse_right); //0
|
||||
x.AddConstantN('mouse_Left','integer').SetInt(ps_mouse_left);//1
|
||||
x.AddConstantN('mouse_Middle','integer').SetInt(ps_mouse_middle);//2
|
||||
AddConstantN('mouse_Right','integer').SetInt(ps_mouse_right); //0
|
||||
AddConstantN('mouse_Left','integer').SetInt(ps_mouse_left);//1
|
||||
AddConstantN('mouse_Middle','integer').SetInt(ps_mouse_middle);//2
|
||||
|
||||
@ -22,17 +22,17 @@
|
||||
}
|
||||
|
||||
{$IFDEF CPU386 }
|
||||
PSScript.Defines.Add('CPU386');
|
||||
Defines.Add('CPU386');
|
||||
{$ENDIF }
|
||||
PSScript.Defines.Add('MUFASA');
|
||||
PSScript.Defines.Add('COGAT');
|
||||
PSScript.Defines.Add('SIMBA');
|
||||
PSScript.Defines.Add('RAYMONDPOWNS');
|
||||
Defines.Add('MUFASA');
|
||||
Defines.Add('COGAT');
|
||||
Defines.Add('SIMBA');
|
||||
Defines.Add('RAYMONDPOWNS');
|
||||
{$IFDEF MSWINDOWS }
|
||||
PSScript.Defines.Add('MSWINDOWS');
|
||||
PSScript.Defines.Add('WIN32');
|
||||
PSScript.Defines.Add('WINDOWS');
|
||||
Defines.Add('MSWINDOWS');
|
||||
Defines.Add('WIN32');
|
||||
Defines.Add('WINDOWS');
|
||||
{$ENDIF }
|
||||
{$IFDEF LINUX }
|
||||
PSScript.Defines.Add('LINUX');
|
||||
Defines.Add('LINUX');
|
||||
{$ENDIF }
|
||||
|
||||
@ -21,13 +21,16 @@
|
||||
psexportedmethods.inc for the Mufasa Macro Library
|
||||
}
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
||||
AddFunction(@pswriteln,'procedure Writeln(x: string);'); //PS defines a special, keep this for CPascal
|
||||
AddFunction(@ps_debugln,'procedure DebugLn(str : string);');
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
{ DTM }
|
||||
SetCurrSection('DTM');
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
AddFunction(@ps_SetDTMName, 'procedure SetDTMName(DTM : integer;const name : string);');
|
||||
AddFunction(@ps_DTMFromString, 'function DTMFromString(const DTMString: String): Integer;');
|
||||
AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
|
||||
@ -42,6 +45,7 @@ AddFunction(@ps_addDTM, 'function AddDTM(const d: TMDTM): Integer;');
|
||||
AddFunction(@ps_addTSDTM, 'function AddSDTM(const d: TSDTM): Integer;');
|
||||
AddFunction(@ps_PrintDTM, 'procedure PrintDTM(const DTM : TMDTM);');
|
||||
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer) : TMDTM');
|
||||
{$ENDIF}
|
||||
AddFunction(@ps_MDTMToSDTM, 'function MDTMToSDTM(Const DTM: TMDTM): TSDTM;');
|
||||
AddFunction(@ps_SDTMToMDTM, 'function SDTMToMDTM(Const DTM: TSDTM): TMDTM;');
|
||||
AddFunction(@ps_CreateDTMPoint,'function CreateDTMPoint(x,y,c,t,asz : integer; bp : boolean) : TMDTMPoint;');
|
||||
@ -79,6 +83,8 @@ AddFunction(@ps_hextoint,'function HexToInt(Hex : string) : integer');
|
||||
AddFunction(@ps_sar,'function sar(AValue : longint; shift : byte) : longint;');
|
||||
AddFunction(@ps_ror,'function ror(num : longword; shift : byte) : LongWord;');
|
||||
AddFunction(@ps_rol,'function rol(num : longword; shift : byte) : LongWord;');
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
{window}
|
||||
SetCurrSection('Window');
|
||||
AddFunction(@ps_Freeze, 'function Freeze: boolean;');
|
||||
@ -97,10 +103,12 @@ AddFunction(@ps_FreeTarget,'procedure FreeTarget(idx: integer);');
|
||||
AddFunction(@ps_SetDesktopAsClient,'procedure SetDesktopAsClient;');
|
||||
AddFunction(@ps_ActivateClient, 'procedure ActivateClient;');
|
||||
AddFunction(@ps_IsTargetValid, 'function IsTargetValid: boolean;');
|
||||
{$ENDIF}
|
||||
|
||||
{files}
|
||||
SetCurrSection('Files');
|
||||
AddFunction(@ps_CreateFile, 'function CreateFile(const Path: string): Integer;');
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
AddFunction(@ps_OpenFile, 'function OpenFile(const Path: string; Shared: Boolean): Integer;');
|
||||
AddFunction(@ps_RewriteFile, 'function RewriteFile(const Path: string; Shared: Boolean): Integer;');
|
||||
AddFunction(@ps_CloseFile, 'procedure CloseFile(FileNum: Integer);');
|
||||
@ -110,10 +118,11 @@ AddFunction(@ps_ReadFileString, 'function ReadFileString(FileNum: Integer; var s
|
||||
AddFunction(@ps_WriteFileString, 'function WriteFileString(FileNum: Integer; s: string): Boolean;');
|
||||
AddFunction(@ps_SetFileCharPointer, 'function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;');
|
||||
AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Integer;');
|
||||
{$ENDIF}
|
||||
AddFunction(@ps_DirectoryExists,'function DirectoryExists(const DirectoryName : string ) : Boolean;');
|
||||
AddFunction(@ps_CreateDirectory,'function CreateDirectory(const DirectoryName : string) : boolean;');
|
||||
AddFunction(@ps_FileExists,'function FileExists (const FileName : string ) : Boolean;');
|
||||
AddFunction(@ps_ForceDirectores,'function ForceDirectores(const dir : string) : boolean;');
|
||||
AddFunction(@ps_ForceDirectores,'function ForceDirectories(const dir : string) : boolean;');
|
||||
AddFunction(@ps_GetFiles,'function GetFiles(const Path, Ext : string) : TStringArray;');
|
||||
AddFunction(@ps_GetDirectories,'function GetDirectories(const path : string) : TStringArray;');
|
||||
AddFunction(@ps_WriteINI,'procedure WriteINI(const Section, KeyName, NewString, FileName: string);');
|
||||
@ -123,31 +132,37 @@ AddFunction(@ps_ExtractFileExt,'function ExtractFileExt(const FileName: string):
|
||||
|
||||
{other}
|
||||
SetCurrSection('Other');
|
||||
AddFunction(@ps_SetSupressExceptions, 'procedure SetSupressExceptions(Supress : boolean);');
|
||||
AddFunction(@ps_SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
|
||||
AddFunction(@ps_Wait, 'procedure wait(t: integer);');
|
||||
AddFunction(@ps_Wait, 'procedure Sleep(t: integer);');
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
AddFunction(@ps_SetSupressExceptions, 'procedure SetSupressExceptions(Supress : boolean);');
|
||||
AddFunction(@ps_SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
|
||||
AddFunction(@ps_TerminateScript,'procedure TerminateScript;');
|
||||
{$ENDIF}
|
||||
AddFunction(@ps_now,'function Now: TDateTime;');
|
||||
AddFunction(@ps_date,'function Date : TDateTime;');
|
||||
AddFunction(@ps_GetTickCount, 'function GetSystemTime: LongWord;');
|
||||
AddFunction(@ps_GetTickCount, 'function GetTickCount: LongWord;');
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
AddFunction(@ps_GetTimeRunning,'function GetTimeRunning: LongWord;');
|
||||
{$ENDIF}
|
||||
AddFunction(@ps_DecodeTime,'procedure DecodeTime(DateTime : TDateTime; var Hour,Min,Sec,MSec : word);');
|
||||
AddFunction(@ps_DecodeDate,'procedure DecodeDate ( const SourceDate : TDateTime; var Year, Month, Day : Word );');
|
||||
AddFunction(@ps_ConvertTime,'procedure ConvertTime(Time: integer; var h, m, s: integer);');
|
||||
AddFunction(@ps_HakunaMatata,'procedure HakunaMatata;');
|
||||
AddFunction(@ps_Simba,'procedure Simba;');
|
||||
AddFunction(@ps_TerminateScript,'procedure TerminateScript;');
|
||||
AddFunction(@ps_Random,'function Random(Int: integer): integer;');
|
||||
AddFunction(@ps_PlaySound,'procedure PlaySound( Sound : string);');
|
||||
AddFunction(@ps_StopSound,'procedure StopSound;');
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
AddFunction(@ps_DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w, h: integer);');
|
||||
AddFunction(@ps_DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp: integer);');
|
||||
AddFunction(@ps_GetDebugBitmap,'function GetDebugBitmap: integer;');
|
||||
AddFunction(@ps_Random,'function Random(Int: integer): integer;');
|
||||
AddFunction(@ps_ClearDebug,'procedure ClearDebug;');
|
||||
AddFunction(@ps_PlaySound,'procedure PlaySound( Sound : string);');
|
||||
AddFunction(@ps_StopSound,'procedure StopSound;');
|
||||
AddFunction(@ps_SetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: TVariantArray): boolean;');
|
||||
AddFunction(@ps_GetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: TVariantArray): boolean;');
|
||||
AddFunction(@ps_InputQuery,'function InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;');
|
||||
{$ENDIF}
|
||||
|
||||
{string}
|
||||
SetCurrSection('String');
|
||||
@ -157,7 +172,9 @@ AddFunction(@ps_DecompressString,'function DecompressString(const Compressed : s
|
||||
AddFunction(@ps_Base64Encode,'function Base64Encode(const str : string) : string;');
|
||||
AddFunction(@ps_Base64Decode,'function Base64Decode(const str : string) : string;');
|
||||
AddFunction(@ps_Format,'function Format(const fmt : string;const args : array of const) : string;');
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
AddFunction(nil,'function ToStr(x) : string;');
|
||||
{$ENDIF}
|
||||
AddFunction(@ps_Between,'function Between(s1, s2, str: string): string;');
|
||||
AddFunction(@ps_IntToStr, 'function IntToStr(value: Integer): String;');
|
||||
AddFunction(@ps_FloatToStr, 'function FloatToStr(value: Extended): String;');
|
||||
@ -181,6 +198,7 @@ AddFunction(@ps_ExecRegExpr,'function ExecRegExpr( const RegExpr, InputStr : Str
|
||||
AddFunction(@ps_SplitRegExpr,'procedure SplitRegExpr( const RegExpr, InputStr : String; Pieces : TStrings);');
|
||||
addfunction(@ps_ReplaceRegExpr,'function ReplaceRegExpr( const RegExpr, InputStr, ReplaceStr : String; UseSubstitution : boolean) : String;');
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
{web}
|
||||
SetCurrSection('Web');
|
||||
AddFunction(@ps_OpenWebPage,'procedure OpenWebPage(const url : string);');
|
||||
@ -195,8 +213,7 @@ AddFunction(@ps_PostHTTPPageEx,'function PostHTTPPageEx(Client: Integer;const Ur
|
||||
AddFunction(@ps_ClearPostData,'procedure ClearPostData(Client: Integer);');
|
||||
AddFunction(@ps_AddPostVariable,'procedure AddPostVariable(Client: Integer;const VarName, VarValue: string);');
|
||||
AddFunction(@ps_GetRawHeaders,'function GetRawHeaders(Client: Integer): string;');
|
||||
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
{ Color Conversions and Speed }
|
||||
SetCurrSection('Color Convert');
|
||||
@ -211,6 +228,7 @@ AddFunction(@ps_HSLToRGB, 'procedure HSLtoRGB(H, S, L: extended; var R, G ,B: In
|
||||
AddFunction(@ps_RGBToXYZ, 'procedure RGBToXYZ(R, G, B: Integer;var x, y ,z: Extended);');
|
||||
AddFunction(@ps_XYZToRGB, 'procedure XYZToRGB(X, Y, Z: Extended; var R, G, B: Integer);');
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
{ Color Finding }
|
||||
SetCurrSection('Color');
|
||||
AddFunction(@ps_SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
|
||||
@ -234,7 +252,9 @@ AddFunction(@ps_FindColorSpiralTolerance,'function FindColorSpiralTolerance(var
|
||||
AddFunction(@ps_FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;');
|
||||
AddFunction(@ps_FindColoredArea, 'function FindColoredArea(var x, y: Integer; color, xs, ys, xe, ye, MinArea: Integer): Boolean');
|
||||
AddFunction(@ps_FindColoredAreaTolerance, 'function FindColoredAreaTolerance(var x, y : Integer; color, xs, ys, xe, ye, MinArea, Tolerance : Integer): Boolean');
|
||||
{$ENDIF}
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
{Mouse etc.}
|
||||
SetCurrSection('Mouse');
|
||||
AddFunction(@ps_MoveMouse, 'procedure MoveMouse(x, y: integer);');
|
||||
@ -244,7 +264,9 @@ AddFunction(@ps_HoldMouse, 'procedure HoldMouse(x, y: integer; clickType: intege
|
||||
AddFunction(@ps_ReleaseMouse, 'procedure ReleaseMouse(x, y: integer; clickType: integer);');
|
||||
AddFunction(@ps_ClickMouse, 'procedure ClickMouse(x, y: integer; clickType: integer);');
|
||||
AddFunction(@ps_IsMouseButtonDown,'function IsMouseButtonDown( button : integer) : boolean;');
|
||||
{$ENDIF}
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
{Keyboard}
|
||||
SetCurrSection('Keyboard');
|
||||
AddFunction(@ps_KeyDown, 'procedure KeyDown(key: Word);');
|
||||
@ -253,7 +275,9 @@ AddFunction(@ps_PressKey, 'procedure PressKey(key: Word);');
|
||||
AddFunction(@ps_SendKeys, 'procedure SendKeys(const s: string);');
|
||||
AddFunction(@ps_isKeyDown, 'function IsKeyDown(key: Word): Boolean;');
|
||||
AddFunction(@ps_GetKeyCode,'function GetKeyCode(c : char) : integer;');
|
||||
{$ENDIF}
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
{ OCR}
|
||||
SetCurrSection('OCR');
|
||||
AddFunction(@ps_rs_GetUpText, 'function rs_GetUpText: string;');
|
||||
@ -269,7 +293,9 @@ AddFunction(@ps_gettextATPA,'function GetTextATPA(const ATPA : T2DPointArray; co
|
||||
AddFunction(@ps_LoadSystemFont,'function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;');
|
||||
AddFunction(@ps_LoadFont, 'function LoadFont(const FontName: string; shadow: boolean): boolean;');
|
||||
AddFunction(@ps_FreeFont, 'function FreeFont(const FontName: string): boolean;');
|
||||
{$ENDIF}
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
{Bitmaps}
|
||||
SetCurrSection('Bitmaps');
|
||||
AddFunction(@ps_CreateBitmapString,'function CreateBitmapString(bmp : integer) : string;');
|
||||
@ -323,6 +349,7 @@ AddFunction(@ps_RectangleBitmap,'procedure RectangleBitmap(bitmap : integer; con
|
||||
AddFunction(@ps_FloodfillBitmap,'procedure FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const SearchCol,ReplaceCol : TColor);');
|
||||
AddFunction(@ps_CalculatePixelShift,'function CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer;');
|
||||
AddFunction(@ps_CalculatePixelTolerance,'function CalculatePixelTolerance(Bmp1,Bmp2 : Integer; CompareBox : TBox; CTS : integer) : extended;');
|
||||
{$ENDIF}
|
||||
|
||||
{tpa}
|
||||
SetCurrSection('TPA');
|
||||
@ -411,6 +438,7 @@ AddFunction(@ps_offsetATPA,'procedure OffsetATPA(var ATPA : T2DPointArray; const
|
||||
AddFunction(@ps_copyTPA,'function CopyTPA(const TPA : TPointArray) : TPointArray;');
|
||||
AddFunction(@ps_CopyATPA,'function CopyATPA(const ATPA : T2DPointArray) : T2DPointArray;');
|
||||
|
||||
{$IFNDEF MML_EXPORT_THREADSAFE}
|
||||
SetCurrSection('Settings');
|
||||
AddFunction(@ps_KeyIsSetting, 'function KeyIsSetting(const KeyName: String): Boolean;');
|
||||
AddFunction(@ps_KeyIsDirectory, 'function KeyIsDirectory(const KeyName: String): Boolean;');
|
||||
@ -420,3 +448,4 @@ AddFunction(@ps_SetSettingValue,'function SetSettingValue(const KeyName,value :
|
||||
AddFunction(@ps_ListSettings, 'function ListSettings(const KeyName: String; var KeyReturn: TStringArray) : boolean;');
|
||||
AddFunction(@ps_DeleteSetting, 'function DeleteSetting(const KeyName: String): Boolean;');
|
||||
AddFunction(@ps_DeleteSubSettings, 'function DeleteSubSettings(const KeyName: String): Boolean;');
|
||||
{$ENDIF}
|
||||
|
||||
@ -17,6 +17,7 @@ begin
|
||||
RegisterMethod('procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray);');
|
||||
RegisterMethod('procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);');
|
||||
RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);');
|
||||
RegisterMethod('procedure DrawToCanvas(x, y: Integer; Canvas: TCanvas);');
|
||||
RegisterMethod('function FastGetPixel(x,y : integer) : TColor;');
|
||||
RegisterMethod('procedure CopyClientToBitmap(Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);');
|
||||
RegisterMethod('procedure Rectangle(const Box : TBox; FillCol : TColor);');
|
||||
|
||||
@ -76,6 +76,7 @@ begin
|
||||
RegisterMethod(@TMufasaBitmap.FastSetPixels,'FASTSETPIXELS');
|
||||
RegisterMethod(@TMufasaBitmap.DrawATPA,'DRAWATPA');
|
||||
RegisterMethod(@TMufasaBitmap.DrawTPA,'DRAWTPA');
|
||||
RegisterMethod(@TMufasaBitmap.DrawToCanvas, 'DRAWTOCANVAS');
|
||||
RegisterMethod(@TMufasaBitmap.FloodFill,'FLOODFILL');
|
||||
RegisterMethod(@TMufasaBitmap.Rectangle,'RECTANGLE');
|
||||
RegisterMethod(@TMufasaBitmap.FastGetPixel,'FASTGETPIXEL');
|
||||
|
||||
@ -86,17 +86,17 @@ type
|
||||
protected
|
||||
ScriptPath, AppPath, IncludePath, PluginPath, FontPath: string;
|
||||
DebugTo: TWritelnProc;
|
||||
DebugClear : TClearDebugProc;
|
||||
DebugImg : TDbgImgInfo;
|
||||
FDebugClear : TClearDebugProc;
|
||||
FDebugImg : TDbgImgInfo;
|
||||
ExportedMethods : TExpMethodArr;
|
||||
Includes : TStringList;
|
||||
Prop: TScriptProperties;
|
||||
FOpenConnectionEvent : TOpenConnectionEvent;
|
||||
FWriteFileEvent : TWriteFileEvent;
|
||||
FOpenFileEvent : TOpenFileEvent;
|
||||
procedure LoadPlugin(plugidx: integer); virtual; abstract;
|
||||
|
||||
public
|
||||
Prop: TScriptProperties;
|
||||
Client : TClient;
|
||||
MInternet : TMInternet;
|
||||
StartTime : LongWord;
|
||||
@ -134,6 +134,8 @@ type
|
||||
property OpenConnectionEvent : TOpenConnectionEvent read FOpenConnectionEvent write SetOpenConnectionEvent;
|
||||
property WriteFileEvent : TWriteFileEvent read FWriteFileEvent write SetWriteFileEvent;
|
||||
property OpenFileEvent : TOpenFileEvent read FOpenFileEvent write SetOpenFileEvent;
|
||||
property DebugClear : TClearDebugProc read FDebugClear write SetDebugClear;
|
||||
property DebugImg : TDbgImgInfo read FDebugImg write SetDbgImg;
|
||||
end;
|
||||
|
||||
{ TPSThread }
|
||||
@ -257,55 +259,6 @@ begin
|
||||
mDebugLn(str);
|
||||
end;
|
||||
|
||||
function MakeString(data : TPSVariantIFC) : string;
|
||||
begin;
|
||||
if data.Dta = nil then
|
||||
result := 'Nil'
|
||||
else
|
||||
if data.aType.basetype in [btString,btChar] then
|
||||
result := PSGetAnsiString(Data.Dta,data.aType)
|
||||
else if data.aType.ExportName = 'BOOLEAN' then
|
||||
result := BoolToStr(PSGetInt(Data.Dta,data.aType) <> 0,true)
|
||||
else
|
||||
result := PSVariantToString(data,'');
|
||||
end;
|
||||
|
||||
function writeln_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
begin
|
||||
Result:=true;
|
||||
psWriteln(makeString(NewTPSVariantIFC(Stack[Stack.Count-1],false)));
|
||||
end;
|
||||
|
||||
function swap_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
var
|
||||
Param1,Param2: TPSVariantIFC;
|
||||
tempCopy : pointer;
|
||||
begin
|
||||
Result:=true;
|
||||
Param1 := NewTPSVariantIFC(Stack[Stack.count-1],true);
|
||||
Param2 := NewTPSVariantIFC(Stack[Stack.count-2],true);
|
||||
if Param1.aType.BaseType <> Param2.aType.BaseType then
|
||||
exit(false)
|
||||
else
|
||||
begin
|
||||
Param1.aType.CalcSize;
|
||||
param2.aType.CalcSize;
|
||||
if Param1.aType.RealSize <> Param2.aType.RealSize then
|
||||
exit(false);
|
||||
GetMem(tempcopy,Param1.aType.RealSize);
|
||||
Move(Param1.Dta^,tempCopy^,param1.atype.realsize);
|
||||
Move(Param2.Dta^,Param1.Dta^,param1.atype.realsize);
|
||||
Move(tempCopy^,Param2.Dta^,param1.atype.realsize);
|
||||
Freemem(tempcopy);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ToStr_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
begin
|
||||
result := true;
|
||||
Stack.SetAnsiString(-1, MakeString(NewTPSVariantIFC(Stack[Stack.Count-2],false)));
|
||||
end;
|
||||
|
||||
{***implementation TMThread***}
|
||||
constructor TMThread.Create(CreateSuspended: boolean; TheSyncInfo: PSyncInfo; plugin_dir: string);
|
||||
begin
|
||||
@ -466,12 +419,12 @@ end;
|
||||
|
||||
procedure TMThread.SetDebugClear(clearProc: TClearDebugProc);
|
||||
begin
|
||||
DebugClear:= clearProc;
|
||||
FDebugClear:= clearProc;
|
||||
end;
|
||||
|
||||
procedure TMThread.SetDbgImg(DebugImageInfo: TDbgImgInfo);
|
||||
begin
|
||||
DebugImg := DebugImageInfo;
|
||||
FDebugImg := DebugImageInfo;
|
||||
end;
|
||||
|
||||
procedure TMThread.SetSettings(S: TMMLSettingsSandbox);
|
||||
@ -567,8 +520,13 @@ begin
|
||||
PSScript.OnCompImport:= @OnCompImport;
|
||||
PSScript.OnExecImport:= @OnExecImport;
|
||||
PSScript.OnFindUnknownFile:=@PSScriptFindUnknownFile;
|
||||
// Set some defines
|
||||
{$I PSInc/psdefines.inc}
|
||||
|
||||
with PSScript do
|
||||
begin
|
||||
// Set some defines
|
||||
{$I PSInc/psdefines.inc}
|
||||
end;
|
||||
|
||||
for i := 0 to high(ExportedMethods) do
|
||||
if pos('Writeln',exportedmethods[i].FuncDecl) > 0 then
|
||||
begin
|
||||
@ -683,7 +641,12 @@ begin
|
||||
SIRegister_Menus(x);
|
||||
SIRegister_ComCtrls(x);
|
||||
SIRegister_Dialogs(x);
|
||||
{$I PSInc/pscompile.inc}
|
||||
|
||||
with x do
|
||||
begin
|
||||
{$I PSInc/pscompile.inc}
|
||||
end;
|
||||
|
||||
SIRegister_Mufasa(x);
|
||||
with x.AddFunction('procedure writeln;').decl do
|
||||
with AddParam do
|
||||
@ -792,7 +755,6 @@ begin
|
||||
psWriteln(PSScript.CompilerErrorToStr(l) + ' at line ' + inttostr(PSScript.CompilerMessages[l].Row - 1));
|
||||
end else
|
||||
psWriteln(PSScript.CompilerErrorToStr(l) + ' at line ' + inttostr(PSScript.CompilerMessages[l].Row - 1));
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -33,6 +33,9 @@ uses
|
||||
const
|
||||
DS = DirectorySeparator;
|
||||
MEOL = {$ifdef MSWINDOWS}#13+{$endif}#10;
|
||||
ps_mouse_right = 0;
|
||||
ps_mouse_left = 1;
|
||||
ps_mouse_middle = 2;
|
||||
|
||||
{ Overloaded Operators}
|
||||
|
||||
|
||||
@ -198,11 +198,11 @@ begin
|
||||
CL.AddTypeS('TFindOptions', 'set of TFindOption');
|
||||
SIRegister_TFindDialog(CL);
|
||||
SIRegister_TReplaceDialog(CL);
|
||||
CL.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmati'
|
||||
+'on, mtCustom )');
|
||||
CL.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m'
|
||||
+'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
|
||||
CL.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
|
||||
//CL.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmati'
|
||||
// +'on, mtCustom )');
|
||||
//CL.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m'
|
||||
// +'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
|
||||
//CL.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
|
||||
CL.AddConstantN('mbYesNoCancel','LongInt').SetInt(ord(mbYes) or ord(mbNo) or ord(mbCancel));
|
||||
CL.AddConstantN('mbOKCancel','LongInt').SetInt(ord(mbOK) or ord(mbCancel));
|
||||
CL.AddConstantN('mbAbortRetryIgnore','LongInt').SetInt(ord(mbAbort) or ord(mbRetry) or ord(mbIgnore));
|
||||
@ -565,13 +565,13 @@ begin T := Self.Handle; end;
|
||||
procedure RIRegister_Dialogs_Routines(S: TPSExec);
|
||||
begin
|
||||
S.RegisterDelphiFunction(@CreateMessageDialog, 'CreateMessageDialog', cdRegister);
|
||||
S.RegisterDelphiFunction(@MessageDlg, 'MessageDlg', cdRegister);
|
||||
{S.RegisterDelphiFunction(@MessageDlg, 'MessageDlg', cdRegister);
|
||||
S.RegisterDelphiFunction(@MessageDlgPos, 'MessageDlgPos', cdRegister);
|
||||
S.RegisterDelphiFunction(@MessageDlgPosHelp, 'MessageDlgPosHelp', cdRegister);
|
||||
S.RegisterDelphiFunction(@ShowMessage, 'ShowMessage', cdRegister);
|
||||
S.RegisterDelphiFunction(@ShowMessagePos, 'ShowMessagePos', cdRegister);
|
||||
S.RegisterDelphiFunction(@InputBox, 'InputBox', cdRegister);
|
||||
S.RegisterDelphiFunction(@InputQuery, 'InputQuery', cdRegister);
|
||||
S.RegisterDelphiFunction(@InputQuery, 'InputQuery', cdRegister);}
|
||||
end;
|
||||
|
||||
(*----------------------------------------------------------------------------*)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user