moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-16 14:25:02 -05:00
Code Issues Releases Wiki Activity

Merge branch 'master' of ssh://villavu.com:54367/simba

Browse Source
This commit is contained in:
Merlijn Wajer 2010-06-06 13:07:50 +02:00
commit 496e4e5dbd
11 changed files with 566 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Plugins/libsmart.dll
View File

Binary file not shown.

4
Projects/Simba/framefunctionlist.lfm
View File

@ -8,8 +8,8 @@ object FunctionListFrame: TFunctionListFrame
ClientWidth = 182 ClientWidth = 182
OnEndDock = FrameEndDock OnEndDock = FrameEndDock
TabOrder = 0 TabOrder = 0
DesignLeft = 401 DesignLeft = 434
DesignTop = 219 DesignTop = 200
object FunctionList: TTreeView object FunctionList: TTreeView
Left = 0 Left = 0
Height = 483 Height = 483

4
Projects/Simba/framescript.lfm
View File

@ -6,8 +6,8 @@ object ScriptFrame: TScriptFrame
ClientHeight = 328 ClientHeight = 328
ClientWidth = 397 ClientWidth = 397
TabOrder = 0 TabOrder = 0
DesignLeft = 159 DesignLeft = 609
DesignTop = 420 DesignTop = 169
inline SynEdit: TSynEdit inline SynEdit: TSynEdit
Left = 0 Left = 0
Height = 328 Height = 328

53
Projects/Simba/psextension.pas
View File

@ -15,32 +15,29 @@ type
{ TSimbaPSExtension } { TSimbaPSExtension }
TSimbaPSExtension = class(TVirtualSimbaExtension) TSimbaPSExtension = class(TVirtualSimbaExtension)
public private
constructor Create(FileStr: String; StartDisabled : boolean = false); PSInstance: TPSScript;
destructor Destroy; override; FWorking: Boolean;
private Script: TStringList;
PSInstance: TPSScript; FClient : TClient;
FWorking: Boolean; procedure StartExtension;
Script: TStringList; function FreeScript: boolean;
procedure StartExtension; function InitScript: Boolean;
private procedure OutputMessages;
function FreeScript: boolean; protected
function InitScript: Boolean; procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
procedure OutputMessages; procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
procedure RegisterMyMethods(x: TPSScript);
public procedure OnPSExecute(Sender: TPSScript);
function HookExists(const HookName: String): Boolean;override; procedure SetEnabled(bool : boolean);override;
function ExecuteHook(const HookName: String;var Args:TVariantArray; out OutVariant : Variant): Integer;override; public
property Working : boolean read FWorking; constructor Create(FileStr: String; StartDisabled : boolean = false);
protected destructor Destroy; override;
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler); function HookExists(const HookName: String): Boolean;override;
procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); function ExecuteHook(const HookName: String;var Args:TVariantArray; out OutVariant : Variant): Integer;override;
procedure RegisterMyMethods(x: TPSScript); property Working : boolean read FWorking;
procedure OnPSExecute(Sender: TPSScript); end;
procedure SetEnabled(bool : boolean);override;
end;
implementation implementation
uses uses
@ -113,6 +110,7 @@ constructor TSimbaPSExtension.Create(FileStr: String; StartDisabled: boolean = f
begin begin
inherited create; inherited create;
FWorking := False; FWorking := False;
FClient := TClient.Create('',SimbaForm.Manager);
FileName := FileStr; FileName := FileStr;
try try
Script := TStringList.Create; Script := TStringList.Create;
@ -206,6 +204,7 @@ begin
AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox'); AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox');
AddRegisteredVariable('Simba','TForm'); AddRegisteredVariable('Simba','TForm');
AddRegisteredVariable('Simba_MainMenu','TMainMenu'); AddRegisteredVariable('Simba_MainMenu','TMainMenu');
AddRegisteredVariable('Client','TClient');
end; end;
end; end;
@ -213,6 +212,7 @@ procedure TSimbaPSExtension.OnPSExecute(Sender: TPSScript);
begin begin
Sender.SetVarToInstance('Simba',SimbaForm); Sender.SetVarToInstance('Simba',SimbaForm);
Sender.SetVarToInstance('Simba_MainMenu',SimbaForm.MainMenu); Sender.SetVarToInstance('Simba_MainMenu',SimbaForm.MainMenu);
Sender.SetVarToInstance('Client',FClient);
Sender.SetPointerToData('Settings',@Self.Settings,Sender.FindNamedType('TMMLSettingsSandbox')); Sender.SetPointerToData('Settings',@Self.Settings,Sender.FindNamedType('TMMLSettingsSandbox'));
end; end;
@ -315,6 +315,7 @@ end;
destructor TSimbaPSExtension.Destroy; destructor TSimbaPSExtension.Destroy;
begin begin
FClient.free;
FreeScript; FreeScript;
if Assigned(PSInstance) then if Assigned(PSInstance) then
FreeAndNil(PSInstance); FreeAndNil(PSInstance);

2
Projects/Simba/simbaunit.pas
View File

@ -46,7 +46,7 @@ uses
CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; CastaliaSimplePasPar, v_AutoCompleteForm, PSDump;
const const
SimbaVersion = 690; SimbaVersion = 695;
type type

6
Units/MMLAddon/PSInc/Wrappers/other.inc
View File

@ -176,6 +176,12 @@ function ps_GetTimeRunning: LongWord; extdecl;
begin; begin;
result := GetTickCount - CurrThread.StartTime; result := GetTickCount - CurrThread.StartTime;
end; end;
function ps_GetTClient : TClient; extdecl;
begin
Result := CurrThread.Client;
end;
{$ENDIF} {$ENDIF}
procedure ps_ConvertTime(Time : integer; var h,m,s : integer); extdecl; procedure ps_ConvertTime(Time : integer; var h,m,s : integer); extdecl;

1
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -136,6 +136,7 @@ SetCurrSection('Other');
AddFunction(@ps_Wait, 'procedure wait(t: integer);'); AddFunction(@ps_Wait, 'procedure wait(t: integer);');
AddFunction(@ps_Wait, 'procedure Sleep(t: integer);'); AddFunction(@ps_Wait, 'procedure Sleep(t: integer);');
{$IFNDEF MML_EXPORT_THREADSAFE} {$IFNDEF MML_EXPORT_THREADSAFE}
AddFunction(@ps_GetTClient,'function GetTClient : TClient;');
AddFunction(@ps_SetSupressExceptions, 'procedure SetSupressExceptions(Supress : boolean);'); AddFunction(@ps_SetSupressExceptions, 'procedure SetSupressExceptions(Supress : boolean);');
AddFunction(@ps_SaveScreenshot,'procedure SaveScreenshot(FileName: string);'); AddFunction(@ps_SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
AddFunction(@ps_TerminateScript,'procedure TerminateScript;'); AddFunction(@ps_TerminateScript,'procedure TerminateScript;');

232
Units/MMLAddon/PSInc/uPSC_mml.pas
View File

@ -19,7 +19,7 @@ begin
RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);'); RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);');
RegisterMethod('procedure DrawToCanvas(x, y: Integer; Canvas: TCanvas);'); RegisterMethod('procedure DrawToCanvas(x, y: Integer; Canvas: TCanvas);');
RegisterMethod('function FastGetPixel(x,y : integer) : TColor;'); 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 Rectangle(const Box : TBox; FillCol : TColor);');
RegisterMethod('procedure FloodFill(const StartPT : TPoint; const SearchCol,ReplaceCol : TColor);'); RegisterMethod('procedure FloodFill(const StartPT : TPoint; const SearchCol,ReplaceCol : TColor);');
// function FastGetPixels(TPA : TPointArray) : TIntegerArray; // function FastGetPixels(TPA : TPointArray) : TIntegerArray;
@ -133,12 +133,242 @@ begin
end; end;
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); procedure SIRegister_MML(cl: TPSPascalCompiler);
begin begin
SIRegister_TMufasaBitmap(cl); SIRegister_TMufasaBitmap(cl);
SIRegister_TRegExp(cl); SIRegister_TRegExp(cl);
SIRegister_TMDTM(cL); SIRegister_TMDTM(cL);
SIRegister_TMMLSettingsSandbox(cl); SIRegister_TMMLSettingsSandbox(cl);
SIRegister_TMDTMS(cl);
SIRegister_TMFinder(cl);
SIRegister_TMBitmaps(cl);
SIRegister_IOManager(cl);
SIRegister_TClient(cl);
end; end;
end. end.

268
Units/MMLAddon/PSInc/uPSR_mml.pas
View File

@ -8,7 +8,9 @@ procedure RIRegister_MML(cl: TPSRuntimeClassImporter);
implementation implementation
uses 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 type
TRegExp = class(SynRegExpr.TRegExpr); 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 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 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 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); procedure RIRegister_TMufasaBitmap(cl : TPSRuntimeClassImporter);
begin begin
@ -80,6 +115,7 @@ begin
RegisterMethod(@TMufasaBitmap.FloodFill,'FLOODFILL'); RegisterMethod(@TMufasaBitmap.FloodFill,'FLOODFILL');
RegisterMethod(@TMufasaBitmap.Rectangle,'RECTANGLE'); RegisterMethod(@TMufasaBitmap.Rectangle,'RECTANGLE');
RegisterMethod(@TMufasaBitmap.FastGetPixel,'FASTGETPIXEL'); RegisterMethod(@TMufasaBitmap.FastGetPixel,'FASTGETPIXEL');
RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'COPYCLIENTTOBITMAP');
RegisterMethod(@TMufasaBitmap.SetTransparentColor,'SETTRANSPARENTCOLOR'); RegisterMethod(@TMufasaBitmap.SetTransparentColor,'SETTRANSPARENTCOLOR');
RegisterMethod(@TMufasaBitmap.GetTransparentColor,'GETTRANSPARENTCOLOR'); RegisterMethod(@TMufasaBitmap.GetTransparentColor,'GETTRANSPARENTCOLOR');
RegisterMethod(@TMufasaBitmap.FastDrawClear,'FASTDRAWCLEAR'); RegisterMethod(@TMufasaBitmap.FastDrawClear,'FASTDRAWCLEAR');
@ -186,12 +222,240 @@ begin
end; end;
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); procedure RIRegister_MML(cl: TPSRuntimeClassImporter);
begin; begin;
RIRegister_TMufasaBitmap(cl); RIRegister_TMufasaBitmap(cl);
RIRegister_TRegExp(cl); RIRegister_TRegExp(cl);
RIRegister_TMDTM(cl); RIRegister_TMDTM(cl);
RIRegister_TMMLSettingsSandbox(cl); RIRegister_TMMLSettingsSandbox(cl);
RIRegister_TMDTMS(cl);
RIRegister_TMFinder(cl);
RIRegister_TMBitmaps(cl);
RIRegister_IOManager(cl);
RIRegister_TClient(cl);
end; end;
end. end.

5
Units/MMLAddon/mmlpsthread.pas
View File

@ -687,10 +687,6 @@ begin
result := Self.Copy(xs,ys,xe,ye); result := Self.Copy(xs,ys,xe,ye);
CurrThread.Client.MBitmaps.AddBMP(result); CurrThread.Client.MBitmaps.AddBMP(result);
end; 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; function TMDTMCreate : TMDTM;
begin begin
result := TMDTM.Create; result := TMDTM.Create;
@ -710,7 +706,6 @@ begin
RegisterConstructor(@TMufasaBitmapCreate,'Create'); RegisterConstructor(@TMufasaBitmapCreate,'Create');
RegisterMethod(@TMufasaBitmapFree,'Free'); RegisterMethod(@TMufasaBitmapFree,'Free');
RegisterMethod(@TMufasaBitmapCopy,'Copy'); RegisterMethod(@TMufasaBitmapCopy,'Copy');
RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'CopyClientToBitmap');
end; end;
With cl.FindClass('TMDTM') do With cl.FindClass('TMDTM') do
begin begin

43
Units/Misc/v_ideCodeInsight.pas
View File

@ -103,20 +103,19 @@ var
begin begin
for i := 0 to High(CoreBuffer) do for i := 0 to High(CoreBuffer) do
FreeAndNil(CoreBuffer[i]); FreeAndNil(CoreBuffer[i]);
SetLength(IncludeBuffer, 0); SetLength(IncludeBuffer, 0);
end; end;
procedure DeleteIncludeBufferIndex(Index: Integer); procedure DeleteIncludeBufferIndex(Index: Integer);
var var
i: Integer; i: Integer;
tmp : TCodeInsight;
begin begin
IncludeBuffer[Index].CodeInsight.Free; tmp := IncludeBuffer[Index].CodeInsight;
for i := Index to High(IncludeBuffer) - 1 do for i := Index to High(IncludeBuffer) - 1 do
IncludeBuffer[i] := IncludeBuffer[i + 1]; IncludeBuffer[i] := IncludeBuffer[i + 1];
SetLength(IncludeBuffer, Length(IncludeBuffer) - 1); SetLength(IncludeBuffer, Length(IncludeBuffer) - 1);
tmp.free;
end; end;
procedure ClearIncludeBuffer; procedure ClearIncludeBuffer;
@ -134,6 +133,8 @@ var
i, l, lc: Integer; i, l, lc: Integer;
Defines: TSaveDefinesRec; Defines: TSaveDefinesRec;
DefineMatch: Boolean; DefineMatch: Boolean;
NewBuf : TIncludeBuffer;
CS : TRTLCriticalSection;
begin begin
lc := 1;//FileAge(FileName); lc := 1;//FileAge(FileName);
Defines := ci.Lexer.SaveDefines; Defines := ci.Lexer.SaveDefines;
@ -166,9 +167,7 @@ begin
end; end;
end; end;
end; end;
with NewBuf do
SetLength(IncludeBuffer, l + 1);
with IncludeBuffer[l] do
begin begin
Script := ci.FileName; Script := ci.FileName;
DefinesIn := Defines; DefinesIn := Defines;
@ -194,9 +193,16 @@ begin
//DefinesOut := Lexer.SaveDefines; Weird bug, so moved out of the with statement //DefinesOut := Lexer.SaveDefines; Weird bug, so moved out of the with statement
ci.Lexer.CloneDefinesFrom(Lexer); ci.Lexer.CloneDefinesFrom(Lexer);
end; end;
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; IncludeBuffer[l].DefinesOut := IncludeBuffer[l].CodeInsight.Lexer.SaveDefines;
Result := IncludeBuffer[l]; Result := IncludeBuffer[l];
end; end;
@ -245,6 +251,8 @@ var
i: Integer; i: Integer;
s: string; s: string;
ci: TCodeInsight; ci: TCodeInsight;
tmp : TIncludeBuffer;
CS : TRTLCriticalSection;
begin begin
Result := False; Result := False;
@ -269,14 +277,21 @@ begin
SetLength(fIncludes, Length(fIncludes) + 1); SetLength(fIncludes, Length(fIncludes) + 1);
fIncludes[High(fIncludes)] := ci; fIncludes[High(fIncludes)] := ci;
SetLength(IncludeBuffer, Length(IncludeBuffer) + 1); with tmp do
with IncludeBuffer[High(IncludeBuffer)] do
begin begin
Script := LibPrefix+LibName; Script := LibPrefix+LibName;
CodeInsight := ci; CodeInsight := ci;
CodeInsight.FileName := LibPrefix+LibName; CodeInsight.FileName := LibPrefix+LibName;
end; end;
InitCriticalSection(cs);
EnterCriticalsection(cs);
try
SetLength(IncludeBuffer, Length(IncludeBuffer) + 1);
IncludeBuffer[high(IncludeBuffer)] := tmp;
finally
LeaveCriticalsection(cs);
end;
DoneCriticalsection(cs);
Exit(True); Exit(True);
end; end;
end; end;
@ -1215,6 +1230,8 @@ var
b: array[1..2] of TDeclaration; b: array[1..2] of TDeclaration;
c: array[0..2] of TDeclarationClass; c: array[0..2] of TDeclarationClass;
begin begin
if item = nil then
exit;
if (Item is TciProcedureDeclaration) then if (Item is TciProcedureDeclaration) then
begin begin
AddFuncDeclaration(TciProcedureDeclaration(Item), ItemList, InsertList); AddFuncDeclaration(TciProcedureDeclaration(Item), ItemList, InsertList);
@ -1339,7 +1356,7 @@ procedure TCodeInsight.FillSynCompletionProposal(ItemList, InsertList: TStrings;
var var
i: Integer; i: Integer;
begin 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; exit;
if (not Item.Proposal_Filled) then if (not Item.Proposal_Filled) then
Item.FillProposal; Item.FillProposal;