diff --git a/Plugins/libsmart.dll b/Plugins/libsmart.dll index fb96b66..9337ed4 100644 Binary files a/Plugins/libsmart.dll and b/Plugins/libsmart.dll differ diff --git a/Projects/Simba/framefunctionlist.lfm b/Projects/Simba/framefunctionlist.lfm index c61f06a..b419ecc 100644 --- a/Projects/Simba/framefunctionlist.lfm +++ b/Projects/Simba/framefunctionlist.lfm @@ -8,8 +8,8 @@ object FunctionListFrame: TFunctionListFrame ClientWidth = 182 OnEndDock = FrameEndDock TabOrder = 0 - DesignLeft = 401 - DesignTop = 219 + DesignLeft = 434 + DesignTop = 200 object FunctionList: TTreeView Left = 0 Height = 483 diff --git a/Projects/Simba/framescript.lfm b/Projects/Simba/framescript.lfm index 5754b6d..f26a57b 100644 --- a/Projects/Simba/framescript.lfm +++ b/Projects/Simba/framescript.lfm @@ -6,8 +6,8 @@ object ScriptFrame: TScriptFrame ClientHeight = 328 ClientWidth = 397 TabOrder = 0 - DesignLeft = 159 - DesignTop = 420 + DesignLeft = 609 + DesignTop = 169 inline SynEdit: TSynEdit Left = 0 Height = 328 diff --git a/Projects/Simba/psextension.pas b/Projects/Simba/psextension.pas index d9b2879..880b5cb 100644 --- a/Projects/Simba/psextension.pas +++ b/Projects/Simba/psextension.pas @@ -15,32 +15,29 @@ type { TSimbaPSExtension } - TSimbaPSExtension = class(TVirtualSimbaExtension) - public - constructor Create(FileStr: String; StartDisabled : boolean = false); - destructor Destroy; override; - private - PSInstance: TPSScript; - FWorking: Boolean; - Script: TStringList; - procedure StartExtension; - private - function FreeScript: boolean; - function InitScript: Boolean; - procedure OutputMessages; - - public - function HookExists(const HookName: String): Boolean;override; - function ExecuteHook(const HookName: String;var Args:TVariantArray; out OutVariant : Variant): Integer;override; - property Working : boolean read FWorking; - protected - procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler); - procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); - procedure RegisterMyMethods(x: TPSScript); - procedure OnPSExecute(Sender: TPSScript); - procedure SetEnabled(bool : boolean);override; - end; - + TSimbaPSExtension = class(TVirtualSimbaExtension) + private + PSInstance: TPSScript; + FWorking: Boolean; + Script: TStringList; + FClient : TClient; + procedure StartExtension; + function FreeScript: boolean; + function InitScript: Boolean; + procedure OutputMessages; + protected + procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler); + procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); + procedure RegisterMyMethods(x: TPSScript); + procedure OnPSExecute(Sender: TPSScript); + procedure SetEnabled(bool : boolean);override; + public + constructor Create(FileStr: String; StartDisabled : boolean = false); + destructor Destroy; override; + function HookExists(const HookName: String): Boolean;override; + function ExecuteHook(const HookName: String;var Args:TVariantArray; out OutVariant : Variant): Integer;override; + property Working : boolean read FWorking; + end; implementation uses @@ -113,6 +110,7 @@ constructor TSimbaPSExtension.Create(FileStr: String; StartDisabled: boolean = f begin inherited create; FWorking := False; + FClient := TClient.Create('',SimbaForm.Manager); FileName := FileStr; try Script := TStringList.Create; @@ -206,6 +204,7 @@ begin AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox'); AddRegisteredVariable('Simba','TForm'); AddRegisteredVariable('Simba_MainMenu','TMainMenu'); + AddRegisteredVariable('Client','TClient'); end; end; @@ -213,6 +212,7 @@ procedure TSimbaPSExtension.OnPSExecute(Sender: TPSScript); begin Sender.SetVarToInstance('Simba',SimbaForm); Sender.SetVarToInstance('Simba_MainMenu',SimbaForm.MainMenu); + Sender.SetVarToInstance('Client',FClient); Sender.SetPointerToData('Settings',@Self.Settings,Sender.FindNamedType('TMMLSettingsSandbox')); end; @@ -315,6 +315,7 @@ end; destructor TSimbaPSExtension.Destroy; begin + FClient.free; FreeScript; if Assigned(PSInstance) then FreeAndNil(PSInstance); diff --git a/Projects/Simba/simbaunit.pas b/Projects/Simba/simbaunit.pas index 3ac1304..64ff586 100644 --- a/Projects/Simba/simbaunit.pas +++ b/Projects/Simba/simbaunit.pas @@ -46,7 +46,7 @@ uses CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; const - SimbaVersion = 690; + SimbaVersion = 695; type diff --git a/Units/MMLAddon/PSInc/Wrappers/other.inc b/Units/MMLAddon/PSInc/Wrappers/other.inc index ea126dd..7196529 100644 --- a/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/Units/MMLAddon/PSInc/Wrappers/other.inc @@ -176,6 +176,12 @@ function ps_GetTimeRunning: LongWord; extdecl; begin; result := GetTickCount - CurrThread.StartTime; end; + +function ps_GetTClient : TClient; extdecl; +begin + Result := CurrThread.Client; +end; + {$ENDIF} procedure ps_ConvertTime(Time : integer; var h,m,s : integer); extdecl; diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index d3a0a42..b416be5 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -136,6 +136,7 @@ SetCurrSection('Other'); AddFunction(@ps_Wait, 'procedure wait(t: integer);'); AddFunction(@ps_Wait, 'procedure Sleep(t: integer);'); {$IFNDEF MML_EXPORT_THREADSAFE} +AddFunction(@ps_GetTClient,'function GetTClient : TClient;'); AddFunction(@ps_SetSupressExceptions, 'procedure SetSupressExceptions(Supress : boolean);'); AddFunction(@ps_SaveScreenshot,'procedure SaveScreenshot(FileName: string);'); AddFunction(@ps_TerminateScript,'procedure TerminateScript;'); diff --git a/Units/MMLAddon/PSInc/uPSC_mml.pas b/Units/MMLAddon/PSInc/uPSC_mml.pas index e01f86f..18aa321 100644 --- a/Units/MMLAddon/PSInc/uPSC_mml.pas +++ b/Units/MMLAddon/PSInc/uPSC_mml.pas @@ -19,7 +19,7 @@ begin 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 CopyClientToBitmap(IOManager : TObject; Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);'); RegisterMethod('procedure Rectangle(const Box : TBox; FillCol : TColor);'); RegisterMethod('procedure FloodFill(const StartPT : TPoint; const SearchCol,ReplaceCol : TColor);'); // function FastGetPixels(TPA : TPointArray) : TIntegerArray; @@ -133,12 +133,242 @@ begin end; end; +procedure SIRegister_TMDTMS(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TObject'),'TMDTMS') do + begin + RegisterMethod('Function AddSDTM( const d : TSDTM) : Integer;'); + RegisterMethod('Function AddMDTM( const d : TMDTM) : Integer;'); + RegisterMethod('Function GetDTM( index : Integer) : TMDTM'); + RegisterMethod('Procedure FreeDTM( DTM : Integer)'); + RegisterMethod('Function StringToDTM( const S : String) : Integer'); + RegisterProperty('DTM', 'TMDTM integer', iptr); + SetDefaultPropery('DTM'); + RegisterMethod('Constructor Create( Owner : TObject)'); + end; +end; + +procedure SIRegister_TMFinder(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TObject'),'TMFinder') do + begin + RegisterProperty('WarnOnly', 'boolean', iptrw); + RegisterMethod('Procedure DefaultOperations( var xs, ys, xe, ye : integer)'); + RegisterMethod('Function FindColorsToleranceOptimised( out Points : TPointArray; Color, xs, ys, xe, ye, Tol : Integer) : Boolean'); + RegisterMethod('Function FindColorToleranceOptimised( out x, y : Integer; Color, xs, ys, xe, ye, tol : Integer) : Boolean'); + RegisterMethod('Function CountColorTolerance( Color, xs, ys, xe, ye, Tolerance : Integer) : Integer'); + RegisterMethod('Function CountColor( Color, xs, ys, xe, ye : Integer) : Integer'); + RegisterMethod('Function SimilarColors( Color1, Color2, Tolerance : Integer) : boolean'); + RegisterMethod('Function FindColor( out x, y : Integer; Color, xs, ys, xe, ye : Integer) : Boolean'); + RegisterMethod('Function FindColorSpiral( var x, y : Integer; color, xs, ys, xe, ye : Integer) : Boolean'); + RegisterMethod('Function FindColorSpiralTolerance( var x, y : Integer; color, xs, ys, xe, ye, Tol : Integer) : Boolean'); + RegisterMethod('Function FindColorTolerance( out x, y : Integer; Color, xs, ys, xe, ye, tol : Integer) : Boolean'); + RegisterMethod('Function FindColorsTolerance( out Points : TPointArray; Color, xs, ys, xe, ye, Tol : Integer) : Boolean'); + RegisterMethod('Function FindColorsSpiralTolerance( x, y : Integer; out Points : TPointArray; color, xs, ys, xe, ye : Integer; Tolerance : Integer) : boolean'); + RegisterMethod('Function FindColors( var TPA : TPointArray; Color, xs, ys, xe, ye : Integer) : Boolean'); + RegisterMethod('Function FindColoredArea( var x, y : Integer; color, xs, ys, xe, ye : Integer; MinArea : Integer) : Boolean'); + RegisterMethod('Function FindColoredAreaTolerance( var x, y : Integer; color, xs, ys, xe, ye : Integer; MinArea, tol : Integer) : Boolean'); + RegisterMethod('Function FindMaskTolerance( const mask : TMask; out x, y : Integer; xs, ys, xe, ye : Integer; Tolerance, ContourTolerance : Integer) : Boolean'); + RegisterMethod('Procedure CheckMask( const Mask : TMask)'); + RegisterMethod('Function FindBitmap( bitmap : TMufasaBitmap; out x, y : Integer) : Boolean'); + RegisterMethod('Function FindBitmapIn( bitmap : TMufasaBitmap; out x, y : Integer; xs, ys, xe, ye : Integer) : Boolean'); + RegisterMethod('Function FindBitmapToleranceIn( bitmap : TMufasaBitmap; out x, y : Integer; xs, ys, xe, ye : Integer; tolerance : Integer) : Boolean'); + RegisterMethod('Function FindBitmapSpiral( bitmap : TMufasaBitmap; var x, y : Integer; xs, ys, xe, ye : Integer) : Boolean'); + RegisterMethod('Function FindBitmapSpiralTolerance( bitmap : TMufasaBitmap; var x, y : Integer; xs, ys, xe, ye, tolerance : integer) : Boolean'); + RegisterMethod('Function FindBitmapsSpiralTolerance( bitmap : TMufasaBitmap; x, y : Integer; out Points : TPointArray; xs, ys, xe, ye, tolerance : Integer) : Boolean'); + RegisterMethod('Function FindDeformedBitmapToleranceIn( bitmap : TMufasaBitmap; out x, y : Integer; xs, ys, xe, ye : Integer; tolerance : Integer; Range : Integer; AllowPartialAccuracy : Boolean; out accuracy : Extended) : Boolean'); + RegisterMethod('Function FindDTM( DTM : TMDTM; out x, y : Integer; x1, y1, x2, y2 : Integer) : Boolean'); + RegisterMethod('Function FindDTMs( DTM : TMDTM; out Points : TPointArray; x1, y1, x2, y2 : integer; maxToFind : Integer) : Boolean'); + RegisterMethod('Function FindDTMRotated( DTM : TMDTM; out x, y : Integer; x1, y1, x2, y2 : Integer; sAngle, eAngle, aStep : Extended; out aFound : Extended; Alternating : boolean) : Boolean'); + RegisterMethod('Function FindDTMsRotated( DTM : TMDTM; out Points : TPointArray; x1, y1, x2, y2 : Integer; sAngle, eAngle, aStep : Extended; out aFound : T2DExtendedArray; Alternating : boolean; maxToFind : Integer) : Boolean'); + RegisterMethod('Function GetColors( const Coords : TPointArray) : TIntegerArray'); + RegisterMethod('Procedure SetToleranceSpeed( nCTS : Integer)'); + RegisterMethod('Function GetToleranceSpeed : Integer'); + RegisterMethod('Procedure SetToleranceSpeed2Modifiers( const nHue, nSat : Extended)'); + RegisterMethod('Procedure GetToleranceSpeed2Modifiers( out hMod, sMod : Extended)'); + RegisterMethod('Constructor Create( aClient : TObject)'); + end; +end; + +procedure SIRegister_TMBitmaps(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TObject'),'TMBitmaps') do + begin + RegisterMethod('Function GetBMP( Index : integer) : TMufasaBitmap'); + RegisterProperty('Bmp', 'TMufasaBitmap integer', iptr); + SetDefaultPropery('Bmp'); + RegisterMethod('Function CreateBMP( w, h : integer) : Integer'); + RegisterMethod('Function AddBMP( _bmp : TMufasaBitmap) : Integer'); + RegisterMethod('Function CopyBMP( Bitmap : integer) : Integer'); + RegisterMethod('Function CreateMirroredBitmap( bitmap : Integer; MirrorStyle : TBmpMirrorStyle) : Integer'); + RegisterMethod('Function CreateBMPFromFile( const Path : string) : integer'); + RegisterMethod('Function CreateBMPFromString( width, height : integer; Data : string) : integer;'); + RegisterMethod('Procedure FreeBMP( Number : integer)'); + RegisterMethod('Constructor Create( Owner : TObject)'); + end; +end; + +procedure SIRegister_TTarget(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TObject'),'TTarget') do + begin + RegisterMethod('Procedure GetTargetDimensions( var w, h : integer)'); + RegisterMethod('Function GetColor( x, y : integer) : TColor'); + RegisterMethod('Function ReturnData( xs, ys, width, height : Integer) : TRetData'); + RegisterMethod('Procedure FreeReturnData'); + RegisterMethod('Procedure ActivateClient'); + RegisterMethod('Function TargetValid : boolean'); + RegisterMethod('Function GetError : String'); + RegisterMethod('Function ReceivedError : Boolean'); + RegisterMethod('Procedure ResetError'); + RegisterMethod('Procedure GetMousePosition( var x, y : integer)'); + RegisterMethod('Procedure MoveMouse( x, y : integer)'); + RegisterMethod('Procedure ScrollMouse( x, y : integer; Lines : integer)'); + RegisterMethod('Procedure HoldMouse( x, y : integer; button : TClickType)'); + RegisterMethod('Procedure ReleaseMouse( x, y : integer; button : TClickType)'); + RegisterMethod('Function IsMouseButtonHeld( button : TClickType) : boolean'); + RegisterMethod('Procedure SendString( str : string)'); + RegisterMethod('Procedure HoldKey( key : integer)'); + RegisterMethod('Procedure ReleaseKey( key : integer)'); + RegisterMethod('Function IsKeyHeld( key : integer) : boolean'); + RegisterMethod('Function GetKeyCode( C : char) : integer'); + end; +end; + +procedure SIRegister_TRawTarget(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TTarget'),'TRawTarget') do + begin + RegisterMethod('Constructor Create( rgb : Integer; w, h : integer; CopyData : boolean)'); + end; +end; + +procedure SIRegister_TBitmapTarget(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TTarget'),'TBitmapTarget') do + begin + RegisterMethod('Constructor Create( bitmap : TMufasaBitmap)'); + end; +end; + +procedure SIRegister_TWindow_Abstract(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TTarget'),'TWindow_Abstract') do + begin + end; +end; + +procedure SIRegister_TEIOS_Target(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TTarget'),'TEIOS_Target') do + begin + RegisterMethod('Constructor Create( client : TEIOS_Client; initval : pointer)'); + end; +end; + +procedure SIRegister_TWindow(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TWindow_Abstract'),'TWindow') do + begin + RegisterMethod('Constructor Create( target : Hwnd)'); + RegisterMethod('Function GetNativeWindow : TNativeWindow'); + end; +end; + +procedure SIRegister_TIOManager_Abstract(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TObject'),'TIOManager_Abstract') do + begin + RegisterMethod('Constructor Create( plugin_dir : string)'); + RegisterMethod('Function GetError : String'); + RegisterMethod('Function ReceivedError : Boolean'); + RegisterMethod('Procedure ResetError'); + RegisterMethod('Procedure SetDesktop'); + RegisterMethod('Function SetTargetArr( ArrPtr : Integer; Size : TPoint) : integer;'); + RegisterMethod('Function SetTargetBmp( bmp : TMufasaBitmap) : integer;'); + RegisterMethod('Function TargetValid : Boolean'); + RegisterMethod('Procedure BitmapDestroyed( Bitmap : TMufasaBitmap)'); + RegisterMethod('Function GetColor( x, y : integer) : TColor'); + RegisterMethod('Function ReturnData( xs, ys, width, height : Integer) : TRetData'); + RegisterMethod('Procedure FreeReturnData'); + RegisterMethod('Procedure GetDimensions( var W, H : Integer)'); + RegisterMethod('Procedure ActivateClient'); + RegisterMethod('Function IsFrozen : boolean'); + RegisterMethod('Procedure SetFrozen( makefrozen : boolean)'); + RegisterMethod('Procedure GetMousePos( var X, Y : Integer)'); + RegisterMethod('Procedure MoveMouse( X, Y : Integer)'); + RegisterMethod('Procedure ScrollMouse( x, y : integer; Lines : integer)'); + RegisterMethod('Procedure HoldMouse( x, y : integer; button : TClickType)'); + RegisterMethod('Procedure ReleaseMouse( x, y : integer; button : TClickType)'); + RegisterMethod('Procedure ClickMouse( X, Y : Integer; button : TClickType)'); + RegisterMethod('Function IsMouseButtonDown( button : TClickType) : boolean'); + RegisterMethod('Procedure KeyUp( key : Word)'); + RegisterMethod('Procedure KeyDown( key : Word)'); + RegisterMethod('Procedure PressKey( key : Word)'); + RegisterMethod('Procedure SendText( text : string)'); + RegisterMethod('Function isKeyDown( key : Word) : Boolean'); + RegisterMethod('Function GetKeyCode( c : char) : integer'); + RegisterMethod('Function GetImageTarget : TTarget;'); + RegisterMethod('Function GetKeyMouseTarget : TTarget;'); + RegisterMethod('Function ExportImageTarget : TTarget_Exported;'); + RegisterMethod('Function ExportKeyMouseTarget : TTarget_Exported;'); + RegisterMethod('Procedure GetImageTarget( var idx : integer);'); + RegisterMethod('Procedure GetKeyMouseTarget( var idx : integer);'); + RegisterMethod('Procedure SetImageTarget( idx : integer)'); + RegisterMethod('Procedure SetKeyMouseTarget( idx : integer)'); + RegisterMethod('Procedure FreeTarget( idx : integer)'); + RegisterMethod('Procedure SetState( val : Boolean)'); + end; +end; + +procedure SIRegister_TIOManager(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TIOManager_Abstract'),'TIOManager') do + begin + RegisterMethod('Constructor Create( plugin_dir : string)'); + RegisterMethod('Function SetTarget( target : TNativeWindow) : integer;'); + end; +end; + +procedure SIRegister_IOManager(CL: TPSPascalCompiler); +begin + SIRegister_TTarget(CL); + SIRegister_TRawTarget(CL); + SIRegister_TBitmapTarget(CL); + SIRegister_TWindow_Abstract(CL); + SIRegister_TEIOS_Target(CL); + SIRegister_TWindow(cl); + SIRegister_TIOManager_Abstract(CL); + SIRegister_TIOManager(cl); +end; + +procedure SIRegister_TClient(CL: TPSPascalCompiler); +begin + with CL.AddClassN(CL.FindClass('TObject'),'TClient') do + begin + RegisterProperty('IOManager', 'TIOManager', iptrw); + RegisterProperty('MFiles', 'TMFiles', iptrw); + RegisterProperty('MFinder', 'TMFinder', iptrw); + RegisterProperty('MBitmaps', 'TMBitmaps', iptrw); + RegisterProperty('MDTMs', 'TMDTMS', iptrw); + RegisterProperty('MOCR', 'TMOCR', iptrw); + RegisterProperty('WritelnProc', 'TWritelnProc', iptrw); + RegisterMethod('Procedure WriteLn( s : string)'); + RegisterMethod('Constructor Create( const plugin_dir : string; const UseIOManager : TIOManager)'); + end; +end; + procedure SIRegister_MML(cl: TPSPascalCompiler); begin SIRegister_TMufasaBitmap(cl); SIRegister_TRegExp(cl); SIRegister_TMDTM(cL); SIRegister_TMMLSettingsSandbox(cl); + SIRegister_TMDTMS(cl); + SIRegister_TMFinder(cl); + SIRegister_TMBitmaps(cl); + SIRegister_IOManager(cl); + SIRegister_TClient(cl); end; end. diff --git a/Units/MMLAddon/PSInc/uPSR_mml.pas b/Units/MMLAddon/PSInc/uPSR_mml.pas index d878cc8..61fbbf6 100644 --- a/Units/MMLAddon/PSInc/uPSR_mml.pas +++ b/Units/MMLAddon/PSInc/uPSR_mml.pas @@ -8,7 +8,9 @@ procedure RIRegister_MML(cl: TPSRuntimeClassImporter); implementation uses - SynRegExpr,bitmaps,dtm,mufasatypes,settingssandbox; + SynRegExpr,bitmaps,dtm,mufasatypes,client,ocr,lcltype,classes,finder,files,iomanager,settingssandbox, + {$IFDEF MSWINDOWS} os_windows {$ENDIF} + {$IFDEF LINUX} os_linux {$ENDIF}; type TRegExp = class(SynRegExpr.TRegExpr); @@ -63,7 +65,40 @@ procedure TMDTMCount_R(Self: TMDTM; var T: Integer);begin T := Self.Count; end; procedure TMDTMPoints_R(Self : TMDTM; var T : TMDTMPointArray); begin t := self.Points; end; procedure TMDTMIndex_R(Self : TMDTM; var T : integer); begin t := self.Index; end; procedure SettingsPrefix(self : TMMLSettingsSandbox; var Prefix : String);begin; Prefix := self.Prefix; end; - +procedure TClientWritelnProc_W(Self: TClient; const T: TWritelnProc);Begin Self.WritelnProc := T; end; +procedure TClientWritelnProc_R(Self: TClient; var T: TWritelnProc);Begin T := Self.WritelnProc; end; +procedure TClientMOCR_W(Self: TClient; const T: TMOCR);Begin Self.MOCR := T; end; +procedure TClientMOCR_R(Self: TClient; var T: TMOCR); Begin T := Self.MOCR; end; +procedure TClientMDTMs_W(Self: TClient; const T: TMDTMS);Begin Self.MDTMs := T; end; +procedure TClientMDTMs_R(Self: TClient; var T: TMDTMS);Begin T := Self.MDTMs; end; +procedure TClientMBitmaps_W(Self: TClient; const T: TMBitmaps);Begin Self.MBitmaps := T; end; +procedure TClientMBitmaps_R(Self: TClient; var T: TMBitmaps);Begin T := Self.MBitmaps; end; +procedure TClientMFinder_W(Self: TClient; const T: TMFinder);Begin Self.MFinder := T; end; +procedure TClientMFinder_R(Self: TClient; var T: TMFinder);Begin T := Self.MFinder; end; +procedure TClientMFiles_W(Self: TClient; const T: TMFiles);Begin Self.MFiles := T; end; +procedure TClientMFiles_R(Self: TClient; var T: TMFiles);Begin T := Self.MFiles; end; +procedure TClientIOManager_W(Self: TClient; const T: TIOManager);Begin Self.IOManager := T; end; +procedure TClientIOManager_R(Self: TClient; var T: TIOManager);Begin T := Self.IOManager; end; +procedure TMFinderWarnOnly_W(Self: TMFinder; const T: boolean);Begin Self.WarnOnly := T; end; +procedure TMFinderWarnOnly_R(Self: TMFinder; var T: boolean);Begin T := Self.WarnOnly; end; +procedure TMDTMSDTM_R(Self: TMDTMS; var T: TMDTM; const t1: integer);begin T := Self.DTM[t1]; end; +Function TMDTMSAddMDTM_P(Self: TMDTMS; const d : TMDTM) : Integer;Begin Result := Self.AddDTM(d); END; +Function TMDTMSAddSDTM_P(Self: TMDTMS; const d : TSDTM) : Integer;Begin Result := Self.AddDTM(d); END; +Function TMBitmapsCreateBMPFromString_P(Self: TMBitmaps; width, height : integer; Data : string) : integer;Begin Result := Self.CreateBMPFromString(width, height, Data); END; +procedure TMBitmapsBmp_R(Self: TMBitmaps; var T: TMufasaBitmap; const t1: integer);begin T := Self.Bmp[t1]; end; +Procedure TIOManager_AbstractGetKeyMouseTarget_P(Self: TIOManager_Abstract; var idx : integer);Begin Self.GetKeyMouseTarget(idx); END; +Procedure TIOManager_AbstractGetImageTarget_P(Self: TIOManager_Abstract; var idx : integer);Begin Self.GetImageTarget(idx); END; +Function TIOManager_AbstractExportKeyMouseTarget_P(Self: TIOManager_Abstract) : TTarget_Exported;Begin Result := Self.ExportKeyMouseTarget; END; +Function TIOManager_AbstractExportImageTarget_P(Self: TIOManager_Abstract) : TTarget_Exported;Begin Result := Self.ExportImageTarget; END; +Function TIOManager_AbstractGetKeyMouseTarget_P(Self: TIOManager_Abstract) : TTarget;Begin Result := Self.GetKeyMouseTarget; END; +Function TIOManager_AbstractGetImageTarget_P(Self: TIOManager_Abstract) : TTarget;Begin Result := Self.GetImageTarget; END; +Function TIOManager_AbstractSetTargetBmp_P(Self: TIOManager_Abstract; bmp : TMufasaBitmap) : integer;Begin Result := Self.SetTarget(bmp); END; +Function TIOManager_AbstractSetTargetArr_P(Self: TIOManager_Abstract; ArrPtr : Integer; Size : TPoint) : integer;Begin Result := Self.SetTarget(PRGB32(ArrPtr), Size); END; +function TWindowCreate(handle : hwnd) : TWindow; begin result := TWindow.Create(handle); end; +function TIOManagerCreate(plugin_dir : string) : TIOManager; begin result := TIOManager.Create(plugin_dir); end; +function TIOManager_AbstractCreate(plugin_dir : string) : TIOManager_Abstract; begin result := TIOManager_Abstract.Create(plugin_dir); end; +Function TIOManagerSetTarget_P(Self: TIOManager; target : TNativeWindow) : integer;Begin Result := Self.SetTarget(target); END; +procedure TMufasaBitmapCopyClientToBitmap(Self : TMufasaBitmap; MWindow : TObject; Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);begin self.CopyClientToBitmap(MWindow,Resize,x,y,xs,ys,xe,ye); end; procedure RIRegister_TMufasaBitmap(cl : TPSRuntimeClassImporter); begin @@ -80,6 +115,7 @@ begin RegisterMethod(@TMufasaBitmap.FloodFill,'FLOODFILL'); RegisterMethod(@TMufasaBitmap.Rectangle,'RECTANGLE'); RegisterMethod(@TMufasaBitmap.FastGetPixel,'FASTGETPIXEL'); + RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'COPYCLIENTTOBITMAP'); RegisterMethod(@TMufasaBitmap.SetTransparentColor,'SETTRANSPARENTCOLOR'); RegisterMethod(@TMufasaBitmap.GetTransparentColor,'GETTRANSPARENTCOLOR'); RegisterMethod(@TMufasaBitmap.FastDrawClear,'FASTDRAWCLEAR'); @@ -186,12 +222,240 @@ begin end; end; +procedure RIRegister_TMDTMS(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TMDTMS) do + begin + RegisterMethod(@TMDTMSAddSDTM_P, 'AddSDTM'); + RegisterMethod(@TMDTMSAddMDTM_P, 'AddMDTM'); + RegisterMethod(@TMDTMS.GetDTM, 'GetDTM'); + RegisterMethod(@TMDTMS.FreeDTM, 'FreeDTM'); + RegisterMethod(@TMDTMS.StringToDTM, 'StringToDTM'); + RegisterPropertyHelper(@TMDTMSDTM_R,nil,'DTM'); + RegisterConstructor(@TMDTMS.Create, 'Create'); + end; +end; + +procedure RIRegister_TMFinder(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TMFinder) do + begin + RegisterPropertyHelper(@TMFinderWarnOnly_R,@TMFinderWarnOnly_W,'WarnOnly'); + RegisterMethod(@TMFinder.DefaultOperations, 'DefaultOperations'); + RegisterMethod(@TMFinder.FindColorsToleranceOptimised, 'FindColorsToleranceOptimised'); + RegisterMethod(@TMFinder.FindColorToleranceOptimised, 'FindColorToleranceOptimised'); + RegisterMethod(@TMFinder.CountColorTolerance, 'CountColorTolerance'); + RegisterMethod(@TMFinder.CountColor, 'CountColor'); + RegisterMethod(@TMFinder.SimilarColors, 'SimilarColors'); + RegisterMethod(@TMFinder.FindColor, 'FindColor'); + RegisterMethod(@TMFinder.FindColorSpiral, 'FindColorSpiral'); + RegisterMethod(@TMFinder.FindColorSpiralTolerance, 'FindColorSpiralTolerance'); + RegisterMethod(@TMFinder.FindColorTolerance, 'FindColorTolerance'); + RegisterMethod(@TMFinder.FindColorsTolerance, 'FindColorsTolerance'); + RegisterMethod(@TMFinder.FindColorsSpiralTolerance, 'FindColorsSpiralTolerance'); + RegisterMethod(@TMFinder.FindColors, 'FindColors'); + RegisterMethod(@TMFinder.FindColoredArea, 'FindColoredArea'); + RegisterMethod(@TMFinder.FindColoredAreaTolerance, 'FindColoredAreaTolerance'); + RegisterMethod(@TMFinder.FindMaskTolerance, 'FindMaskTolerance'); + RegisterMethod(@TMFinder.CheckMask, 'CheckMask'); + RegisterMethod(@TMFinder.FindBitmap, 'FindBitmap'); + RegisterMethod(@TMFinder.FindBitmapIn, 'FindBitmapIn'); + RegisterMethod(@TMFinder.FindBitmapToleranceIn, 'FindBitmapToleranceIn'); + RegisterMethod(@TMFinder.FindBitmapSpiral, 'FindBitmapSpiral'); + RegisterMethod(@TMFinder.FindBitmapSpiralTolerance, 'FindBitmapSpiralTolerance'); + RegisterMethod(@TMFinder.FindBitmapsSpiralTolerance, 'FindBitmapsSpiralTolerance'); + RegisterMethod(@TMFinder.FindDeformedBitmapToleranceIn, 'FindDeformedBitmapToleranceIn'); + RegisterMethod(@TMFinder.FindDTM, 'FindDTM'); + RegisterMethod(@TMFinder.FindDTMs, 'FindDTMs'); + RegisterMethod(@TMFinder.FindDTMRotated, 'FindDTMRotated'); + RegisterMethod(@TMFinder.FindDTMsRotated, 'FindDTMsRotated'); + RegisterMethod(@TMFinder.GetColors, 'GetColors'); + RegisterMethod(@TMFinder.SetToleranceSpeed, 'SetToleranceSpeed'); + RegisterMethod(@TMFinder.GetToleranceSpeed, 'GetToleranceSpeed'); + RegisterMethod(@TMFinder.SetToleranceSpeed2Modifiers, 'SetToleranceSpeed2Modifiers'); + RegisterMethod(@TMFinder.GetToleranceSpeed2Modifiers, 'GetToleranceSpeed2Modifiers'); + RegisterConstructor(@TMFinder.Create, 'Create'); + end; +end; + +procedure RIRegister_TMBitmaps(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TMBitmaps) do + begin + RegisterMethod(@TMBitmaps.GetBMP, 'GetBMP'); + RegisterPropertyHelper(@TMBitmapsBmp_R,nil,'Bmp'); + RegisterMethod(@TMBitmaps.CreateBMP, 'CreateBMP'); + RegisterMethod(@TMBitmaps.AddBMP, 'AddBMP'); + RegisterMethod(@TMBitmaps.CopyBMP, 'CopyBMP'); + RegisterMethod(@TMBitmaps.CreateMirroredBitmap, 'CreateMirroredBitmap'); + RegisterMethod(@TMBitmaps.CreateBMPFromFile, 'CreateBMPFromFile'); + RegisterMethod(@TMBitmapsCreateBMPFromString_P, 'CreateBMPFromString'); + RegisterMethod(@TMBitmaps.FreeBMP, 'FreeBMP'); + RegisterConstructor(@TMBitmaps.Create, 'Create'); + end; +end; + +procedure RIRegister_TTarget(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TTarget) do + begin + RegisterVirtualMethod(@TTarget.GetTargetDimensions, 'GetTargetDimensions'); + RegisterVirtualMethod(@TTarget.GetColor, 'GetColor'); + RegisterVirtualMethod(@TTarget.ReturnData, 'ReturnData'); + RegisterVirtualMethod(@TTarget.FreeReturnData, 'FreeReturnData'); + RegisterVirtualMethod(@TTarget.ActivateClient, 'ActivateClient'); + RegisterVirtualMethod(@TTarget.TargetValid, 'TargetValid'); +{ RegisterVirtualAbstractMethod(TTarget,@TTarget.GetError, 'GetError'); + RegisterVirtualAbstractMethod(TTarget,@TTarget.ReceivedError, 'ReceivedError'); + RegisterVirtualAbstractMethod(Ttarget,@TTarget.ResetError, 'ResetError');} + RegisterVirtualMethod(@TTarget.GetMousePosition, 'GetMousePosition'); + RegisterVirtualMethod(@TTarget.MoveMouse, 'MoveMouse'); + RegisterVirtualMethod(@TTarget.ScrollMouse, 'ScrollMouse'); + RegisterVirtualMethod(@TTarget.HoldMouse, 'HoldMouse'); + RegisterVirtualMethod(@TTarget.ReleaseMouse, 'ReleaseMouse'); + RegisterVirtualMethod(@TTarget.IsMouseButtonHeld, 'IsMouseButtonHeld'); + RegisterVirtualMethod(@TTarget.SendString, 'SendString'); + RegisterVirtualMethod(@TTarget.HoldKey, 'HoldKey'); + RegisterVirtualMethod(@TTarget.ReleaseKey, 'ReleaseKey'); + RegisterVirtualMethod(@TTarget.IsKeyHeld, 'IsKeyHeld'); + RegisterVirtualMethod(@TTarget.GetKeyCode, 'GetKeyCode'); + end; +end; + +procedure RIRegister_TRawTarget(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TRawTarget) do + begin + RegisterConstructor(@TRawTarget.Create, 'Create'); + end; +end; + +procedure RIRegister_TBitmapTarget(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TBitmapTarget) do + begin + RegisterConstructor(@TBitmapTarget.Create, 'Create'); + end; +end; + +procedure RIRegister_TWindow_Abstract(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TWindow_Abstract) do + begin + end; +end; + +procedure RIRegister_TEIOS_Target(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TEIOS_Target) do + begin + RegisterConstructor(@TEIOS_Target.Create, 'Create'); + end; +end; + +procedure RIRegister_TWindow(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TWindow) do + begin + RegisterConstructor(@TWindowCreate, 'Create'); + RegisterMethod(@TWindow.GetNativeWindow, 'GetNativeWindow'); + end; +end; + +procedure RIRegister_TIOManager_Abstract(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TIOManager_Abstract) do + begin + RegisterConstructor(@TIOManager_AbstractCreate, 'Create'); + RegisterMethod(@TIOManager_Abstract.GetError, 'GetError'); + RegisterMethod(@TIOManager_Abstract.ReceivedError, 'ReceivedError'); + RegisterMethod(@TIOManager_Abstract.ResetError, 'ResetError'); +// RegisterVirtualAbstractMethod(TIOManager_Abstract, @TIOManager_Abstract.SetDesktop, 'SetDesktop'); + RegisterMethod(@TIOManager_AbstractSetTargetArr_P, 'SetTargetArr'); + RegisterMethod(@TIOManager_AbstractSetTargetBmp_P, 'SetTargetBmp'); + RegisterMethod(@TIOManager_Abstract.TargetValid, 'TargetValid'); + RegisterMethod(@TIOManager_Abstract.BitmapDestroyed, 'BitmapDestroyed'); + RegisterMethod(@TIOManager_Abstract.GetColor, 'GetColor'); + RegisterMethod(@TIOManager_Abstract.ReturnData, 'ReturnData'); + RegisterMethod(@TIOManager_Abstract.FreeReturnData, 'FreeReturnData'); + RegisterMethod(@TIOManager_Abstract.GetDimensions, 'GetDimensions'); + RegisterMethod(@TIOManager_Abstract.ActivateClient, 'ActivateClient'); + RegisterMethod(@TIOManager_Abstract.IsFrozen, 'IsFrozen'); + RegisterMethod(@TIOManager_Abstract.SetFrozen, 'SetFrozen'); + RegisterMethod(@TIOManager_Abstract.GetMousePos, 'GetMousePos'); + RegisterMethod(@TIOManager_Abstract.MoveMouse, 'MoveMouse'); + RegisterMethod(@TIOManager_Abstract.ScrollMouse, 'ScrollMouse'); + RegisterMethod(@TIOManager_Abstract.HoldMouse, 'HoldMouse'); + RegisterMethod(@TIOManager_Abstract.ReleaseMouse, 'ReleaseMouse'); + RegisterMethod(@TIOManager_Abstract.ClickMouse, 'ClickMouse'); + RegisterMethod(@TIOManager_Abstract.IsMouseButtonDown, 'IsMouseButtonDown'); + RegisterMethod(@TIOManager_Abstract.KeyUp, 'KeyUp'); + RegisterMethod(@TIOManager_Abstract.KeyDown, 'KeyDown'); + RegisterMethod(@TIOManager_Abstract.PressKey, 'PressKey'); + RegisterMethod(@TIOManager_Abstract.SendText, 'SendText'); + RegisterMethod(@TIOManager_Abstract.isKeyDown, 'isKeyDown'); + RegisterMethod(@TIOManager_Abstract.GetKeyCode, 'GetKeyCode'); + RegisterMethod(@TIOManager_AbstractGetImageTarget_P, 'GetImageTarget'); + RegisterMethod(@TIOManager_AbstractGetKeyMouseTarget_P, 'GetKeyMouseTarget'); + RegisterMethod(@TIOManager_AbstractExportImageTarget_P, 'ExportImageTarget'); + RegisterMethod(@TIOManager_AbstractExportKeyMouseTarget_P, 'ExportKeyMouseTarget'); + RegisterMethod(@TIOManager_AbstractGetImageTarget_P, 'GetImageTarget'); + RegisterMethod(@TIOManager_AbstractGetKeyMouseTarget_P, 'GetKeyMouseTarget'); + RegisterMethod(@TIOManager_Abstract.SetImageTarget, 'SetImageTarget'); + RegisterMethod(@TIOManager_Abstract.SetKeyMouseTarget, 'SetKeyMouseTarget'); + RegisterMethod(@TIOManager_Abstract.FreeTarget, 'FreeTarget'); + RegisterMethod(@TIOManager_Abstract.SetState, 'SetState'); + end; +end; + +procedure RIRegister_TIOManager(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TIOManager) do + begin + RegisterConstructor(@TIOManagerCreate, 'Create'); + RegisterMethod(@TIOManagerSetTarget_P, 'SetTarget'); + end; +end; + +procedure RIRegister_IOManager(CL: TPSRuntimeClassImporter); +begin + RIRegister_TTarget(CL); + RIRegister_TRawTarget(CL); + RIRegister_TBitmapTarget(CL); + RIRegister_TWindow_Abstract(CL); + RIRegister_TEIOS_Target(CL); + RIRegister_TWindow(cl); + RIRegister_TIOManager_Abstract(CL); + RIRegister_TIOManager(cl); +end; + +procedure RIRegister_TClient(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TClient) do + begin + RegisterPropertyHelper(@TClientIOManager_R,@TClientIOManager_W,'IOManager'); + RegisterPropertyHelper(@TClientMFiles_R,@TClientMFiles_W,'MFiles'); + RegisterPropertyHelper(@TClientMFinder_R,@TClientMFinder_W,'MFinder'); + RegisterPropertyHelper(@TClientMBitmaps_R,@TClientMBitmaps_W,'MBitmaps'); + RegisterPropertyHelper(@TClientMDTMs_R,@TClientMDTMs_W,'MDTMs'); + RegisterPropertyHelper(@TClientMOCR_R,@TClientMOCR_W,'MOCR'); + RegisterPropertyHelper(@TClientWritelnProc_R,@TClientWritelnProc_W,'WritelnProc'); + RegisterMethod(@TClient.WriteLn, 'WriteLn'); + RegisterConstructor(@TClient.Create, 'Create'); + end; +end; + procedure RIRegister_MML(cl: TPSRuntimeClassImporter); begin; RIRegister_TMufasaBitmap(cl); RIRegister_TRegExp(cl); RIRegister_TMDTM(cl); RIRegister_TMMLSettingsSandbox(cl); + RIRegister_TMDTMS(cl); + RIRegister_TMFinder(cl); + RIRegister_TMBitmaps(cl); + RIRegister_IOManager(cl); + RIRegister_TClient(cl); end; end. diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index e48ca2d..7b84b12 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -687,10 +687,6 @@ begin result := Self.Copy(xs,ys,xe,ye); CurrThread.Client.MBitmaps.AddBMP(result); end; -procedure TMufasaBitmapCopyClientToBitmap(self : TMufasaBitmap; Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer); -begin - self.CopyClientToBitmap(CurrThread.Client.IOManager,resize,x,y,xs,ys,xe,ye); -end; function TMDTMCreate : TMDTM; begin result := TMDTM.Create; @@ -710,7 +706,6 @@ begin RegisterConstructor(@TMufasaBitmapCreate,'Create'); RegisterMethod(@TMufasaBitmapFree,'Free'); RegisterMethod(@TMufasaBitmapCopy,'Copy'); - RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'CopyClientToBitmap'); end; With cl.FindClass('TMDTM') do begin diff --git a/Units/Misc/v_ideCodeInsight.pas b/Units/Misc/v_ideCodeInsight.pas index 938edc8..69da244 100644 --- a/Units/Misc/v_ideCodeInsight.pas +++ b/Units/Misc/v_ideCodeInsight.pas @@ -103,20 +103,19 @@ var begin for i := 0 to High(CoreBuffer) do FreeAndNil(CoreBuffer[i]); - SetLength(IncludeBuffer, 0); end; procedure DeleteIncludeBufferIndex(Index: Integer); var i: Integer; + tmp : TCodeInsight; begin - IncludeBuffer[Index].CodeInsight.Free; - + tmp := IncludeBuffer[Index].CodeInsight; for i := Index to High(IncludeBuffer) - 1 do IncludeBuffer[i] := IncludeBuffer[i + 1]; - SetLength(IncludeBuffer, Length(IncludeBuffer) - 1); + tmp.free; end; procedure ClearIncludeBuffer; @@ -134,6 +133,8 @@ var i, l, lc: Integer; Defines: TSaveDefinesRec; DefineMatch: Boolean; + NewBuf : TIncludeBuffer; + CS : TRTLCriticalSection; begin lc := 1;//FileAge(FileName); Defines := ci.Lexer.SaveDefines; @@ -166,9 +167,7 @@ begin end; end; end; - - SetLength(IncludeBuffer, l + 1); - with IncludeBuffer[l] do + with NewBuf do begin Script := ci.FileName; DefinesIn := Defines; @@ -194,9 +193,16 @@ begin //DefinesOut := Lexer.SaveDefines; Weird bug, so moved out of the with statement ci.Lexer.CloneDefinesFrom(Lexer); end; - end; - + InitCriticalSection(cs); + EnterCriticalsection(cs); + try + SetLength(IncludeBuffer, l + 1); + IncludeBuffer[l] := NewBuf; + finally + LeaveCriticalsection(cs); + end; + DoneCriticalsection(cs); IncludeBuffer[l].DefinesOut := IncludeBuffer[l].CodeInsight.Lexer.SaveDefines; Result := IncludeBuffer[l]; end; @@ -245,6 +251,8 @@ var i: Integer; s: string; ci: TCodeInsight; + tmp : TIncludeBuffer; + CS : TRTLCriticalSection; begin Result := False; @@ -269,14 +277,21 @@ begin SetLength(fIncludes, Length(fIncludes) + 1); fIncludes[High(fIncludes)] := ci; - SetLength(IncludeBuffer, Length(IncludeBuffer) + 1); - with IncludeBuffer[High(IncludeBuffer)] do + with tmp do begin Script := LibPrefix+LibName; CodeInsight := ci; CodeInsight.FileName := LibPrefix+LibName; end; - + InitCriticalSection(cs); + EnterCriticalsection(cs); + try + SetLength(IncludeBuffer, Length(IncludeBuffer) + 1); + IncludeBuffer[high(IncludeBuffer)] := tmp; + finally + LeaveCriticalsection(cs); + end; + DoneCriticalsection(cs); Exit(True); end; end; @@ -1215,6 +1230,8 @@ var b: array[1..2] of TDeclaration; c: array[0..2] of TDeclarationClass; begin + if item = nil then + exit; if (Item is TciProcedureDeclaration) then begin AddFuncDeclaration(TciProcedureDeclaration(Item), ItemList, InsertList); @@ -1339,7 +1356,7 @@ procedure TCodeInsight.FillSynCompletionProposal(ItemList, InsertList: TStrings; var i: Integer; begin - if item = nil then + if (item = nil) or (ItemList = nil) or (InsertList = nil) or (Item.Proposal_InsertList = nil) or (Item.Proposal_ItemList = nil) then exit; if (not Item.Proposal_Filled) then Item.FillProposal;