diff --git a/Plugins/libsmart.dll b/Plugins/libsmart.dll index d447b85..fb96b66 100644 Binary files a/Plugins/libsmart.dll and b/Plugins/libsmart.dll differ diff --git a/Projects/OCRBench/unit1.pas b/Projects/OCRBench/unit1.pas index 1a8069c..2bd31e3 100644 --- a/Projects/OCRBench/unit1.pas +++ b/Projects/OCRBench/unit1.pas @@ -96,7 +96,7 @@ begin // DS + .. + DS because InitOCR wants the directory of the Fonts, not UpChars // only. C.MOCR.InitTOCR(FontPath + DS); - C.MOCR.SetFonts(C.MOCR.GetFonts); + //C.MOCR.SetFonts(C.MOCR.GetFonts); t:=gettickcount; @@ -125,6 +125,7 @@ begin Form1.Image1.Picture.SaveToFile(OCRDebugPath + 'ocrbench.bmp'); {$ENDIF} + bmp.OnDestroy:=nil; bmp.Free; C.Free; Application.ProcessMessages; diff --git a/Projects/SAMufasaGUI/Makefile b/Projects/Simba/Makefile similarity index 96% rename from Projects/SAMufasaGUI/Makefile rename to Projects/Simba/Makefile index 9d79011..875ff1f 100644 --- a/Projects/SAMufasaGUI/Makefile +++ b/Projects/Simba/Makefile @@ -1,4 +1,4 @@ -#$ fpc -MObjFPC -Scgi -O2 -OoREGVAR -gl -vewnhi -l -Fu../../Units/MMLCore/ -Fu../../Units/MMLAddon/ -Fu../../Units/PascalScript/ -Fu../../Units/Misc/ -Fu../../../lazarus/components/synedit/units/x86_64-linux/ -Fu../../../lazarus/ideintf/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/gtk2/ -Fu../../../lazarus/packager/units/x86_64-linux/ -Fu. -oSAMufasaGUI -dUseCThreads -dM_MEMORY_DEBUG -dLCL -dLCLgtk2 project1.lpr +#$ fpc -MObjFPC -Scgi -O2 -OoREGVAR -gl -vewnhi -l -Fu../../Units/MMLCore/ -Fu../../Units/MMLAddon/ -Fu../../Units/PascalScript/ -Fu../../Units/Misc/ -Fu../../../lazarus/components/synedit/units/x86_64-linux/ -Fu../../../lazarus/ideintf/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/gtk2/ -Fu../../../lazarus/packager/units/x86_64-linux/ -Fu. -oSAMufasaGUI -dUseCThreads -dM_MEMORY_DEBUG -dLCL -dLCLgtk2 Simba.lpr .PHONY: default clean @@ -30,6 +30,6 @@ clean: rm -f *.o *.ppu $(binary) $(binary): - $(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) project1.lpr + $(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) Simba.lpr -Fu/usr/local/share/lazarus/ideintf/units/x86_64-linux/ diff --git a/Projects/SAMufasaGUI/Makefile.win b/Projects/Simba/Makefile.win similarity index 96% rename from Projects/SAMufasaGUI/Makefile.win rename to Projects/Simba/Makefile.win index 94389ba..7ba8429 100644 --- a/Projects/SAMufasaGUI/Makefile.win +++ b/Projects/Simba/Makefile.win @@ -1,4 +1,4 @@ -#$ fpc -MObjFPC -Scgi -O2 -OoREGVAR -gl -vewnhi -l -Fu../../Units/MMLCore/ -Fu../../Units/MMLAddon/ -Fu../../Units/PascalScript/ -Fu../../Units/Misc/ -Fu../../../lazarus/components/synedit/units/x86_64-linux/ -Fu../../../lazarus/ideintf/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/gtk2/ -Fu../../../lazarus/packager/units/x86_64-linux/ -Fu. -oSAMufasaGUI -dUseCThreads -dM_MEMORY_DEBUG -dLCL -dLCLgtk2 project1.lpr +#$ fpc -MObjFPC -Scgi -O2 -OoREGVAR -gl -vewnhi -l -Fu../../Units/MMLCore/ -Fu../../Units/MMLAddon/ -Fu../../Units/PascalScript/ -Fu../../Units/Misc/ -Fu../../../lazarus/components/synedit/units/x86_64-linux/ -Fu../../../lazarus/ideintf/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/ -Fu../../../lazarus/lcl/units/x86_64-linux/gtk2/ -Fu../../../lazarus/packager/units/x86_64-linux/ -Fu. -oSAMufasaGUI -dUseCThreads -dM_MEMORY_DEBUG -dLCL -dLCLgtk2 Simba.lpr .PHONY: default clean @@ -27,4 +27,4 @@ clean: del $(binary) $(binary): - $(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) project1.lpr + $(CC) $(flags) $(units) $(lazarusunits) -o$(binary) $(defines) Simba.lpr diff --git a/Projects/SAMufasaGUI/project1.ico b/Projects/Simba/Simba.ico similarity index 100% rename from Projects/SAMufasaGUI/project1.ico rename to Projects/Simba/Simba.ico diff --git a/Projects/SAMufasaGUI/project1.lpi b/Projects/Simba/Simba.lpi similarity index 94% rename from Projects/SAMufasaGUI/project1.lpi rename to Projects/Simba/Simba.lpi index 3560cf7..f18cf8d 100644 --- a/Projects/SAMufasaGUI/project1.lpi +++ b/Projects/Simba/Simba.lpi @@ -40,19 +40,19 @@ - + - + - + - + - + - + @@ -205,7 +205,7 @@ - + @@ -271,7 +271,7 @@ - + @@ -288,6 +288,13 @@ + + + + + + + @@ -319,4 +326,11 @@ + + + + + + + diff --git a/Projects/SAMufasaGUI/project1.lpr b/Projects/Simba/Simba.lpr similarity index 83% rename from Projects/SAMufasaGUI/project1.lpr rename to Projects/Simba/Simba.lpr index d94613e..e772d32 100644 --- a/Projects/SAMufasaGUI/project1.lpr +++ b/Projects/Simba/Simba.lpr @@ -21,34 +21,35 @@ SAMufasaGUI for the Mufasa Macro Library } -program project1; +program Simba; {$mode objfpc}{$H+} -{$DEFINE SIMBA} +{$DEFINE Simba} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, cmem, {$ENDIF}{$ENDIF} - Interfaces, Forms, testunit, colourhistory, About, internets, debugimage, - framefunctionlist, simpleanalyzer, updater, updateform, simbasettings, + Interfaces, Forms, SimbaUnit, colourhistory, About, internets, debugimage, + framefunctionlist, simpleanalyzer, updater, updateform, Simbasettings, libloader, mufasabase, v_ideCodeInsight, PSDump, v_ideCodeParser, v_AutoCompleteForm, CastaliaPasLex, CastaliaPasLexTypes, CastaliaSimplePasPar, CastaliaSimplePasParTypes, dcpbase64, mPasLex, v_Constants, v_MiscFunctions, - extensionmanagergui, mmisc; + extensionmanagergui, mmisc, bitmapconv; -{$R project1.res} +{$R Simba.res} begin Application.Title:='Simba'; Application.Initialize; - Application.CreateForm(TForm1, Form1); + Application.CreateForm(TSimbaForm, SimbaForm); Application.CreateForm(TColourHistoryForm, ColourHistoryForm); Application.CreateForm(TAboutForm, AboutForm); Application.CreateForm(TDebugImgForm, DebugImgForm); Application.CreateForm(TExtensionsForm, ExtensionsForm); + Application.CreateForm(TBitmapConvForm, BitmapConvForm); // Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm); // Application.CreateForm(TSettingsForm, SettingsForm); Done in FormCreate of MainForm Application.Run; diff --git a/Projects/SAMufasaGUI/project1.res b/Projects/Simba/Simba.res similarity index 100% rename from Projects/SAMufasaGUI/project1.res rename to Projects/Simba/Simba.res diff --git a/Projects/SAMufasaGUI/about.lfm b/Projects/Simba/about.lfm similarity index 100% rename from Projects/SAMufasaGUI/about.lfm rename to Projects/Simba/about.lfm diff --git a/Projects/SAMufasaGUI/about.pas b/Projects/Simba/about.pas similarity index 90% rename from Projects/SAMufasaGUI/about.pas rename to Projects/Simba/about.pas index 75b2c61..e47ada0 100644 --- a/Projects/SAMufasaGUI/about.pas +++ b/Projects/Simba/about.pas @@ -54,15 +54,15 @@ var implementation uses - TestUnit; + SimbaUnit; { TAboutForm } procedure TAboutForm.FormCreate(Sender: TObject); begin - Self.Caption := format('About Simba r%d', [TestUnit.SimbaVersion]); - Self.LabelRevision.Caption := format('Revision %d', [TestUnit.SimbaVersion]); + Self.Caption := format('About Simba r%d', [SimbaUnit.SimbaVersion]); + Self.LabelRevision.Caption := format('Revision %d', [SimbaUnit.SimbaVersion]); AboutMemo.Lines.Add('Simba is released under the GPL license.'); - AboutMemo.Lines.Add(format('You are currently using version: %d',[Testunit.SimbaVersion])); + AboutMemo.Lines.Add(format('You are currently using version: %d',[SimbaUnit.SimbaVersion])); AboutMemo.Lines.Add(''); AboutMemo.Lines.Add('Please report bugs at: http://mufasa.villavu.com/mantis/'); end; diff --git a/Projects/Simba/bitmapconv.lfm b/Projects/Simba/bitmapconv.lfm new file mode 100644 index 0000000..e441d9a --- /dev/null +++ b/Projects/Simba/bitmapconv.lfm @@ -0,0 +1,68 @@ +object BitmapConvForm: TBitmapConvForm + Left = 726 + Height = 240 + Top = 192 + Width = 320 + Caption = 'Bitmap conversion' + ClientHeight = 240 + ClientWidth = 320 + Constraints.MinHeight = 240 + Constraints.MinWidth = 320 + LCLVersion = '0.9.29' + object ToStringButton: TButton + Left = 192 + Height = 36 + Top = 184 + Width = 113 + Anchors = [akRight, akBottom] + Caption = 'To string' + OnClick = ToStringButtonClick + TabOrder = 0 + end + object PadOutput: TCheckBox + Left = 192 + Height = 17 + Top = 160 + Width = 71 + Anchors = [akRight, akBottom] + Caption = 'Pad output' + Checked = True + State = cbChecked + TabOrder = 1 + end + object OpenButton: TButton + Left = 12 + Height = 36 + Top = 184 + Width = 90 + Anchors = [akRight, akBottom] + Caption = 'Open' + OnClick = OpenButtonClick + TabOrder = 2 + end + object GroupBox: TGroupBox + Left = 12 + Height = 145 + Top = 8 + Width = 284 + Anchors = [akTop, akLeft, akRight, akBottom] + Caption = 'Image' + ClientHeight = 127 + ClientWidth = 280 + TabOrder = 3 + object ImagePreview: TImage + Left = 0 + Height = 127 + Top = 0 + Width = 280 + Align = alClient + Center = True + end + end + object OpenPictureDialog: TOpenPictureDialog + FilterIndex = 2 + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing, ofViewDetail] + left = 128 + top = 184 + end +end diff --git a/Projects/Simba/bitmapconv.pas b/Projects/Simba/bitmapconv.pas new file mode 100644 index 0000000..a9e5de9 --- /dev/null +++ b/Projects/Simba/bitmapconv.pas @@ -0,0 +1,91 @@ +unit bitmapconv; + +{$mode objfpc}{$h+} + +interface + +uses + Classes, SysUtils, FileUtil, bitmaps, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, EditBtn, ExtDlgs, ExtCtrls; + +type + + { TBitmapConvForm } + + TBitmapConvForm = class(TForm) + GroupBox: TGroupBox; + ToStringButton: TButton; + OpenButton: TButton; + PadOutput: TCheckBox; + ImagePreview: TImage; + OpenPictureDialog: TOpenPictureDialog; + procedure OpenButtonClick(Sender: TObject); + procedure ToStringButtonClick(Sender: TObject); + private + { private declarations } + public + dispPic : TMufasaBitmap; + { public declarations } + end; + +var + BitmapConvForm: TBitmapConvForm; + +implementation +uses + SimbaUnit; +const + BmpSizeTxt = '(%dx%d)'; +{$R *.lfm} + +{ TBitmapConvForm } + +procedure TBitmapConvForm.OpenButtonClick(Sender: TObject); +var + x : TMufasaBitmap; +begin + if OpenPictureDialog.Execute then + begin + try + ImagePreview.Picture.LoadFromFile(OpenPictureDialog.FileName); + GroupBox.Caption:= Format(BmpSizeTxt,[ImagePreview.Picture.Width,ImagePreview.Picture.Height]); + x := TMufasaBitmap.Create; + x.LoadFromFile(OpenPictureDialog.FileName); + if dispPic <> nil then + dispPic.Free; + dispPic := x; + except + formWritelnEx('ERROR loading the file: ' + OpenPictureDialog.FileName); + ImagePreview.Picture := nil; + if dispPic <> nil then + FreeAndNil(dispPic); + end; + end; +end; + +procedure TBitmapConvForm.ToStringButtonClick(Sender: TObject); +var + str : string; + strend : string; + len : integer; +begin + if dispPic <> nil then + begin + str := ' Bmp := BitmapFromString('+ + inttostr(disppic.Width)+ ', ' + inttostr(disppic.height) +', '#39 + dispPic.ToString; + strend := #39 +');'; + len := length(str); + if PadOutput.Checked then + while Len > 65 do + begin + formWritelnEx(Copy(str,1,62) + #39 + ' +'); + delete(str,1,62); + str := StringOfChar(' ',8) + #39 + str; + len := length(str); + end; + formWritelnEx(str + strend); + end; +end; + +end. + diff --git a/Projects/SAMufasaGUI/colourhistory.lfm b/Projects/Simba/colourhistory.lfm similarity index 100% rename from Projects/SAMufasaGUI/colourhistory.lfm rename to Projects/Simba/colourhistory.lfm diff --git a/Projects/SAMufasaGUI/colourhistory.pas b/Projects/Simba/colourhistory.pas similarity index 98% rename from Projects/SAMufasaGUI/colourhistory.pas rename to Projects/Simba/colourhistory.pas index e7a741d..50f5361 100644 --- a/Projects/SAMufasaGUI/colourhistory.pas +++ b/Projects/Simba/colourhistory.pas @@ -104,7 +104,7 @@ var implementation uses - colour_conv, TestUnit, lclintf, lcltype; + colour_conv, SimbaUnit, lclintf, lcltype; constructor TColourPickerObject.Create(C: Integer; P: TPoint; N: String); begin @@ -502,7 +502,7 @@ constructor TColourHistoryForm.Create(TheOwner: TComponent); begin inherited Create(TheOwner); - PickNewColourButton.OnClick:= @Form1.ButtonPickClick; + PickNewColourButton.OnClick:= @SimbaForm.ButtonPickClick; end; destructor TColourHistoryForm.Destroy; @@ -544,12 +544,12 @@ end; procedure TColourHistoryForm.SetCHShowMenu(Sender: TObject); begin - Form1.MenuItemColourHistory.Checked := True; + SimbaForm.MenuItemColourHistory.Checked := True; end; procedure TColourHistoryForm.UnSetCHShowMenu(Sender: TObject); begin - Form1.MenuItemColourHistory.Checked := False; + SimbaForm.MenuItemColourHistory.Checked := False; end; initialization diff --git a/Projects/SAMufasaGUI/debugimage.lfm b/Projects/Simba/debugimage.lfm similarity index 82% rename from Projects/SAMufasaGUI/debugimage.lfm rename to Projects/Simba/debugimage.lfm index cd75727..9fed3c4 100644 --- a/Projects/SAMufasaGUI/debugimage.lfm +++ b/Projects/Simba/debugimage.lfm @@ -1,15 +1,16 @@ object DebugImgForm: TDebugImgForm - Left = 1335 + Left = 393 Height = 300 - Top = 172 + Top = 278 Width = 400 BorderIcons = [biSystemMenu, biMinimize] - BorderStyle = bsSingle + BorderStyle = bsToolWindow Caption = 'DebugImgForm' ClientHeight = 300 ClientWidth = 400 OnCreate = FormCreate OnHide = FormHide + Position = poMainFormCenter LCLVersion = '0.9.29' object DrawImage: TImage Left = 0 diff --git a/Projects/SAMufasaGUI/debugimage.pas b/Projects/Simba/debugimage.pas similarity index 95% rename from Projects/SAMufasaGUI/debugimage.pas rename to Projects/Simba/debugimage.pas index ac3bfa8..53b8dca 100644 --- a/Projects/SAMufasaGUI/debugimage.pas +++ b/Projects/Simba/debugimage.pas @@ -59,7 +59,7 @@ var implementation uses - MufasaTypes, math, graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase; + MufasaTypes, math, graphtype, IntfGraphics,SimbaUnit,lclintf,colour_conv,InterfaceBase; { TDebugImgForm } procedure TDebugImgForm.FormCreate(Sender: TObject); @@ -76,7 +76,7 @@ end; procedure TDebugImgForm.FormHide(Sender: TObject); begin - Form1.MenuItemDebugImage.Checked := False; + SimbaForm.MenuItemDebugImage.Checked := False; end; procedure TDebugImgForm.BlackDebugImage; diff --git a/Projects/SAMufasaGUI/extensionmanager.pas b/Projects/Simba/extensionmanager.pas similarity index 98% rename from Projects/SAMufasaGUI/extensionmanager.pas rename to Projects/Simba/extensionmanager.pas index 722da31..8727080 100644 --- a/Projects/SAMufasaGUI/extensionmanager.pas +++ b/Projects/Simba/extensionmanager.pas @@ -38,7 +38,7 @@ var implementation uses - TestUnit, settingssandbox,simbasettings; + SimbaUnit, settingssandbox,Simbasettings; procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent); var diff --git a/Projects/SAMufasaGUI/extensionmanagergui.lfm b/Projects/Simba/extensionmanagergui.lfm similarity index 100% rename from Projects/SAMufasaGUI/extensionmanagergui.lfm rename to Projects/Simba/extensionmanagergui.lfm diff --git a/Projects/SAMufasaGUI/extensionmanagergui.pas b/Projects/Simba/extensionmanagergui.pas similarity index 100% rename from Projects/SAMufasaGUI/extensionmanagergui.pas rename to Projects/Simba/extensionmanagergui.pas diff --git a/Projects/SAMufasaGUI/framefunctionlist.lfm b/Projects/Simba/framefunctionlist.lfm similarity index 98% rename from Projects/SAMufasaGUI/framefunctionlist.lfm rename to Projects/Simba/framefunctionlist.lfm index afd316d..c61f06a 100644 --- a/Projects/SAMufasaGUI/framefunctionlist.lfm +++ b/Projects/Simba/framefunctionlist.lfm @@ -12,11 +12,11 @@ object FunctionListFrame: TFunctionListFrame DesignTop = 219 object FunctionList: TTreeView Left = 0 - Height = 479 - Top = 20 + Height = 483 + Top = 18 Width = 182 Align = alClient - DefaultItemHeight = 17 + DefaultItemHeight = 15 ReadOnly = True ScrollBars = ssAutoBoth TabOrder = 0 @@ -28,8 +28,8 @@ object FunctionListFrame: TFunctionListFrame end object editSearchList: TEdit Left = 0 - Height = 23 - Top = 499 + Height = 21 + Top = 501 Width = 182 Align = alBottom OnChange = editSearchListChange @@ -37,7 +37,7 @@ object FunctionListFrame: TFunctionListFrame end object FunctionListLabel: TLabel Left = 2 - Height = 16 + Height = 14 Top = 2 Width = 178 Align = alTop diff --git a/Projects/SAMufasaGUI/framefunctionlist.pas b/Projects/Simba/framefunctionlist.pas similarity index 89% rename from Projects/SAMufasaGUI/framefunctionlist.pas rename to Projects/Simba/framefunctionlist.pas index a0fb571..a83f6d2 100644 --- a/Projects/SAMufasaGUI/framefunctionlist.pas +++ b/Projects/Simba/framefunctionlist.pas @@ -72,7 +72,7 @@ type implementation uses - TestUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeParser,lclintf; + SimbaUnit, Graphics, stringutil, simpleanalyzer,v_ideCodeParser,lclintf; { TFunctionListFrame } @@ -99,14 +99,14 @@ procedure TFunctionListFrame.FrameEndDock(Sender, Target: TObject; X, Y: Integer begin if Target is TPanel then begin - Form1.SplitterFunctionList.Visible := true; + SimbaForm.SplitterFunctionList.Visible := true; CloseButton.Visible:= true; end else if Target is TCustomDockForm then begin TCustomDockForm(Target).Caption := 'Functionlist'; TCustomDockForm(Target).OnClose := @DockFormOnClose; - Form1.SplitterFunctionList.Visible:= false; + SimbaForm.SplitterFunctionList.Visible:= false; CloseButton.Visible:= false; end; end; @@ -125,8 +125,8 @@ begin if node.Data <> nil then if InCodeCompletion then begin - Form1.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true)); - Form1.RefreshTab; + SimbaForm.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true)); + SimbaForm.RefreshTab; end else begin @@ -138,10 +138,10 @@ begin if MethodInfo.Filename <> '' then begin; // Writeln(MethodInfo.filename); - Form1.LoadScriptFile(MethodInfo.Filename,true,true); + SimbaForm.LoadScriptFile(MethodInfo.Filename,true,true); end; - Form1.CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1; - Form1.CurrScript.SynEdit.SelEnd := MethodInfo.EndPos + 1; + SimbaForm.CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1; + SimbaForm.CurrScript.SynEdit.SelEnd := MethodInfo.EndPos + 1; end; end; end; @@ -172,13 +172,13 @@ end; procedure TFunctionListFrame.DockFormOnClose(Sender: TObject; var CloseAction: TCloseAction); begin CloseAction := caHide; - Form1.MenuItemFunctionList.Checked := False; + SimbaForm.MenuItemFunctionList.Checked := False; end; procedure TFunctionListFrame.CloseButtonClick(Sender: TObject); begin self.Hide; - Form1.MenuItemFunctionList.Checked := False; + SimbaForm.MenuItemFunctionList.Checked := False; end; procedure TFunctionListFrame.FunctionListMouseUp(Sender: TObject; @@ -248,8 +248,8 @@ begin FillThread.Analyzer := TCodeInsight.Create; with FillThread,FillThread.Analyzer do begin - OnFindInclude := @Form1.OnCCFindInclude; - FileName := Form1.CurrScript.ScriptFile; + OnFindInclude := @SimbaForm.OnCCFindInclude; + FileName := SimbaForm.CurrScript.ScriptFile; MS := TMemoryStream.Create; MS.Write(Script[1],length(script)); OnTerminate:=@FillThreadTerminate; @@ -278,9 +278,9 @@ begin FunctionList.FullCollapse; if InCodeCompletion then begin; - Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart; - Form1.CurrScript.SynEdit.LogicalCaretXY:= point(CompletionCaret.x,CompletionCaret.y); - Form1.CurrScript.SynEdit.SelEnd:= Form1.CurrScript.SynEdit.SelStart; + SimbaForm.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart; + SimbaForm.CurrScript.SynEdit.LogicalCaretXY:= point(CompletionCaret.x,CompletionCaret.y); + SimbaForm.CurrScript.SynEdit.SelEnd:= SimbaForm.CurrScript.SynEdit.SelStart; end; FilterTreeVis(False); ScriptNode.Expand(true); @@ -403,7 +403,7 @@ begin FilterTreeVis(false); editSearchList.Color := 6711039; if InCodeCompletion then - Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart; + SimbaForm.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart; end; FilterTree.EndUpdate; end; @@ -411,7 +411,7 @@ begin if result and InCodeCompletion then begin; str := format(CompletionLine, [InsertStr]); - with Form1.CurrScript.SynEdit do + with SimbaForm.CurrScript.SynEdit do begin; Lines[CompletionCaret.y - 1] := str; LogicalCaretXY:= StartWordCompletion; @@ -474,20 +474,21 @@ procedure TFillThread.execute; if procs = nil then exit; for i := 0 to Procs.Count - 1 do - if (Procs[i] is TciProcedureDeclaration) then + if (Procs[i] <> nil) and (Procs[i] is TciProcedureDeclaration) then with Procs[i] as TciProcedureDeclaration do - begin - tmpNode := FunctionList^.Items.AddChild(Node,name.ShortText); - tmpNode.Data := GetMem(SizeOf(TMethodInfo)); - FillChar(PMethodInfo(tmpNode.Data)^,SizeOf(TMethodInfo),0); - with PMethodInfo(tmpNode.Data)^ do + if name <> nil then begin - MethodStr := strnew(Pchar(CleanDeclaration)); - Filename:= strnew(pchar(path)); - BeginPos:= name.StartPos ; - EndPos := name.StartPos + Length(TrimRight(name.RawText)); + tmpNode := FunctionList^.Items.AddChild(Node,name.ShortText); + tmpNode.Data := GetMem(SizeOf(TMethodInfo)); + FillChar(PMethodInfo(tmpNode.Data)^,SizeOf(TMethodInfo),0); + with PMethodInfo(tmpNode.Data)^ do + begin + MethodStr := strnew(Pchar(CleanDeclaration)); + Filename:= strnew(pchar(path)); + BeginPos:= name.StartPos ; + EndPos := name.StartPos + Length(TrimRight(name.RawText)); + end; end; - end; end; procedure AddIncludes(ParentNode : TTreeNode; Include : TCodeInsight); diff --git a/Projects/SAMufasaGUI/framescript.lfm b/Projects/Simba/framescript.lfm similarity index 99% rename from Projects/SAMufasaGUI/framescript.lfm rename to Projects/Simba/framescript.lfm index f0ad4a6..5754b6d 100644 --- a/Projects/SAMufasaGUI/framescript.lfm +++ b/Projects/Simba/framescript.lfm @@ -20,7 +20,7 @@ object ScriptFrame: TScriptFrame Font.Quality = fqNonAntialiased ParentColor = False ParentFont = False - PopupMenu = Form1.ScriptPopup + PopupMenu = SimbaForm.ScriptPopup TabOrder = 0 OnDragDrop = SynEditDragDrop OnDragOver = SynEditDragOver diff --git a/Projects/SAMufasaGUI/framescript.pas b/Projects/Simba/framescript.pas similarity index 86% rename from Projects/SAMufasaGUI/framescript.pas rename to Projects/Simba/framescript.pas index 70e19b0..07c7450 100644 --- a/Projects/SAMufasaGUI/framescript.pas +++ b/Projects/Simba/framescript.pas @@ -85,7 +85,6 @@ type procedure MakeActiveScriptFrame; procedure ScriptThreadTerminate(Sender: TObject); constructor Create(TheOwner: TComponent); override; - destructor Destroy; override; { public declarations } end; @@ -93,7 +92,7 @@ type implementation uses - TestUnit, SynEditTypes, LCLIntF, StrUtils,framefunctionlist; + SimbaUnit, SynEditTypes, LCLIntF, StrUtils,framefunctionlist; function WordAtCaret(e: TSynEdit; var sp, ep: Integer; Start: Integer = -1): string; var @@ -156,7 +155,7 @@ begin if not ScriptChanged then begin; ScriptChanged:= True; - Form1.Caption:= Format(WindowTitle,[ScriptName + '*']); + SimbaForm.Caption:= Format(WindowTitle,[ScriptName + '*']); OwnerSheet.Caption:=ScriptName + '*'; end; end; @@ -172,8 +171,8 @@ var begin mp := TCodeInsight.Create; mp.FileName := ScriptFile; - mp.OnMessage := @Form1.OnCCMessage; - mp.OnFindInclude := @Form1.OnCCFindInclude; + mp.OnMessage := @SimbaForm.OnCCMessage; + mp.OnFindInclude := @SimbaForm.OnCCFindInclude; ms := TMemoryStream.Create; SynEdit.Lines.SaveToStream(ms); @@ -194,10 +193,10 @@ begin begin if FileExists(TCodeInsight(d.Parser).FileName) then begin; - if Form1.LoadScriptFile(TCodeInsight(d.Parser).FileName,true,true) then + if SimbaForm.LoadScriptFile(TCodeInsight(d.Parser).FileName,true,true) then begin; - Form1.CurrScript.SynEdit.SelStart:= d.StartPos + 1; - Form1.CurrScript.SynEdit.SelEnd := d.StartPos + Length(TrimRight(d.RawText)) + 1; + SimbaForm.CurrScript.SynEdit.SelStart:= d.StartPos + 1; + SimbaForm.CurrScript.SynEdit.SelEnd := d.StartPos + Length(TrimRight(d.RawText)) + 1; end; end else @@ -220,7 +219,7 @@ procedure TScriptFrame.SynEditCommandProcessed(Sender: TObject; var Command2 : TSynEditorCommand; begin - if (Command = ecChar) and (AChar = '(') and (Form1.ParamHint.Visible = false) and (Form1.ShowHintAuto) then + if (Command = ecChar) and (AChar = '(') and (SimbaForm.ParamHint.Visible = false) and (SimbaForm.ShowHintAuto) then begin Command2:= ecCodeHints; SynEditProcessUserCommand(sender,command2,achar,nil); @@ -237,12 +236,12 @@ end; procedure TScriptFrame.SynEditDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin - Accept := Source = Form1.frmFunctionList; + Accept := Source = SimbaForm.frmFunctionList; if(Accept)then begin SynEdit.CaretXY := SynEdit.PixelsToLogicalPos(point(x, y)); - if(not(Form1.Active))then Form1.BringToFront; - if(Form1.ActiveControl <> SynEdit)then Form1.ActiveControl := SynEdit; + if(not(SimbaForm.Active))then SimbaForm.BringToFront; + if(SimbaForm.ActiveControl <> SynEdit)then SimbaForm.ActiveControl := SynEdit; end; end; @@ -251,18 +250,18 @@ procedure TScriptFrame.SynEditKeyDown(Sender: TObject; var Key: Word; begin if key = VK_F3 then begin; - Form1.ActionFindNextExecute(Sender); + SimbaForm.ActionFindNextExecute(Sender); key := 0; end; if key = VK_ESCAPE then - Form1.ParamHint.Hide; + SimbaForm.ParamHint.Hide; - Form1.CodeCompletionForm.HandleKeyDown(Sender, Key, Shift); + SimbaForm.CodeCompletionForm.HandleKeyDown(Sender, Key, Shift); end; procedure TScriptFrame.SynEditKeyPress(Sender: TObject; var Key: char); begin - Form1.CodeCompletionForm.HandleKeyPress(Sender, Key); + SimbaForm.CodeCompletionForm.HandleKeyPress(Sender, Key); end; procedure TScriptFrame.SynEditMouseLink(Sender: TObject; X, Y: Integer; @@ -309,8 +308,8 @@ begin if (Command = ecCodeCompletion) and ((not SynEdit.GetHighlighterAttriAtRowCol(SynEdit.CaretXY, s, Attri)) or ((Attri.Name <> SYNS_AttrComment) and (Attri.name <> SYNS_AttrString) and (Attri.name <> SYNS_AttrDirective))) then begin - {form1.FunctionListShown(True); - with form1.frmFunctionList do + {SimbaForm.FunctionListShown(True); + with SimbaForm.frmFunctionList do if editSearchList.CanFocus then begin; editSearchList.SetFocus; @@ -348,8 +347,8 @@ begin end;} mp := TCodeInsight.Create; mp.FileName := ScriptFile; - mp.OnMessage := @Form1.OnCCMessage; - mp.OnFindInclude := @Form1.OnCCFindInclude; + mp.OnMessage := @SimbaForm.OnCCMessage; + mp.OnFindInclude := @SimbaForm.OnCCFindInclude; ms := TMemoryStream.Create; ItemList := TStringList.Create; @@ -360,7 +359,7 @@ begin try Filter := WordAtCaret(Synedit, sp, ep); - Form1.CodeCompletionStart := Point(sp, Synedit.CaretY); + SimbaForm.CodeCompletionStart := Point(sp, Synedit.CaretY); //mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1); s := SynEdit.Lines[SynEdit.Carety-1]; @@ -382,7 +381,7 @@ begin mp.FillSynCompletionProposal(ItemList, InsertList, s); p := SynEdit.ClientToScreen(SynEdit.RowColumnToPixels(Point(ep, SynEdit.CaretY))); p.y := p.y + SynEdit.LineHeight; - Form1.CodeCompletionForm.Show(p, ItemList, InsertList, Filter, SynEdit); + SimbaForm.CodeCompletionForm.Show(p, ItemList, InsertList, Filter, SynEdit); finally FreeAndNil(ms); FreeAndNil(mp); @@ -392,11 +391,11 @@ begin end; if command = ecCodeHints then begin - if Form1.ParamHint.Visible = true then - form1.ParamHint.hide; + if SimbaForm.ParamHint.Visible = true then + SimbaForm.ParamHint.hide; mp := TCodeInsight.Create; - mp.OnMessage := @form1.OnCCMessage; - mp.OnFindInclude := @form1.OnCCFindInclude; + mp.OnMessage := @SimbaForm.OnCCMessage; + mp.OnFindInclude := @SimbaForm.OnCCFindInclude; ms := TMemoryStream.Create; synedit.Lines.SaveToStream(ms); @@ -441,7 +440,7 @@ begin if (not (d is TciProcedureDeclaration)) and (d.Owner is TciProcedureDeclaration) then d := d.Owner; if (TciProcedureDeclaration(d).Params <> '') then - Form1.ParamHint.Show(PosToCaretXY(synedit,posi + 1), PosToCaretXY(synedit,bracketpos), + SimbaForm.ParamHint.Show(PosToCaretXY(synedit,posi + 1), PosToCaretXY(synedit,bracketpos), TciProcedureDeclaration(d), synedit,mp) else FormWriteln(''); @@ -452,21 +451,21 @@ begin //Do not free the MP, we need to use this. end; end; - if Form1.CodeCompletionForm.Visible then + if SimbaForm.CodeCompletionForm.Visible then case Command of ecDeleteChar, ecDeleteWord, ecDeleteEOL: begin - if (SynEdit.CaretY = Form1.CodeCompletionStart.y) then + if (SynEdit.CaretY = SimbaForm.CodeCompletionStart.y) then begin //e.GetWordBoundsAtRowCol(acp_start, sp, ep); - s := WordAtCaret(SynEdit, sp, ep, Form1.CodeCompletionStart.x); - if (SynEdit.CaretX >= Form1.CodeCompletionStart.x) and (SynEdit.CaretX <= ep) then + s := WordAtCaret(SynEdit, sp, ep, SimbaForm.CodeCompletionStart.x); + if (SynEdit.CaretX >= SimbaForm.CodeCompletionStart.x) and (SynEdit.CaretX <= ep) then begin - Form1.CodeCompletionForm.ListBox.Filter := s; + SimbaForm.CodeCompletionForm.ListBox.Filter := s; Exit; end; end; - Form1.CodeCompletionForm.Hide; + SimbaForm.CodeCompletionForm.Hide; end; end; end; @@ -491,28 +490,28 @@ begin {$IFDEF UpdateEditButtons} if scSelection in changes then begin; - Form1.TT_Cut.Enabled := SynEdit.SelAvail; - form1.TT_Copy.Enabled:= Form1.TT_Cut.Enabled; - form1.TT_Paste.Enabled:= SynEdit.CanPaste; + SimbaForm.TT_Cut.Enabled := SynEdit.SelAvail; + SimbaForm.TT_Copy.Enabled:= SimbaForm.TT_Cut.Enabled; + SimbaForm.TT_Paste.Enabled:= SynEdit.CanPaste; end; {$ENDIF} - if Form1.CodeCompletionForm.Visible then + if SimbaForm.CodeCompletionForm.Visible then if (scAll in Changes) or (scTopLine in Changes) then - Form1.CodeCompletionForm.Visible := False + SimbaForm.CodeCompletionForm.Visible := False else if (scCaretX in Changes) or (scCaretY in Changes) or (scSelection in Changes) or (scModified in Changes) then begin - if (SynEdit.CaretY = Form1.CodeCompletionStart.y) then + if (SynEdit.CaretY = SimbaForm.CodeCompletionStart.y) then begin - s := WordAtCaret(SynEdit, sp, ep, Form1.CodeCompletionStart.x); - if (SynEdit.CaretX >= Form1.CodeCompletionStart.x) and (SynEdit.CaretX - 1 <= ep) then + s := WordAtCaret(SynEdit, sp, ep, SimbaForm.CodeCompletionStart.x); + if (SynEdit.CaretX >= SimbaForm.CodeCompletionStart.x) and (SynEdit.CaretX - 1 <= ep) then begin - Form1.CodeCompletionForm.ListBox.Filter := s; + SimbaForm.CodeCompletionForm.ListBox.Filter := s; Exit; end; end; - Form1.CodeCompletionForm.Hide; + SimbaForm.CodeCompletionForm.Hide; end; end; @@ -522,7 +521,7 @@ begin if ScriptChanged then if SynEdit.Lines.Text = StartText then begin; - Form1.Caption:= format(WindowTitle,[ScriptName]); + SimbaForm.Caption:= format(WindowTitle,[ScriptName]); OwnerSheet.Caption:= ScriptName; ScriptChanged := false; end; @@ -534,7 +533,7 @@ begin if ScriptChanged then if SynEdit.Lines.Text = StartText then begin; - Form1.Caption:= format(WindowTitle,[ScriptName]); + SimbaForm.Caption:= format(WindowTitle,[ScriptName]); OwnerSheet.Caption := ScriptName; ScriptChanged := false; end; @@ -551,10 +550,10 @@ begin else begin ErrorData.Module:= SetDirSeparators(ErrorData.Module);// Set it right ;-) - Form1.LoadScriptFile(ErrorData.Module,true,true);//Checks if the file is already open! + SimbaForm.LoadScriptFile(ErrorData.Module,true,true);//Checks if the file is already open! ErrorData.Module:= ''; - Form1.CurrScript.ErrorData := Self.ErrorData; - Form1.CurrScript.HandleErrorData; + SimbaForm.CurrScript.ErrorData := Self.ErrorData; + SimbaForm.CurrScript.HandleErrorData; exit; end; end; @@ -575,7 +574,7 @@ procedure TScriptFrame.MakeActiveScriptFrame; var i : integer; begin - if Form1.Visible then + if SimbaForm.Visible then for i := 0 to OwnerPage.PageCount - 1 do if OwnerPage.Pages[i] = OwnerSheet then begin; @@ -589,7 +588,7 @@ end; procedure TScriptFrame.ScriptThreadTerminate(Sender: TObject); begin FScriptState:= ss_None; - Form1.RefreshTab; + SimbaForm.RefreshTab; end; procedure AddKey(const SynEdit : TSynEdit; const ACmd: TSynEditorCommand; const AKey: word;const AShift: TShiftState); begin @@ -614,7 +613,7 @@ begin FScriptState:= ss_None; ScriptErrorLine:= -1; OwnerSheet.Caption:= ScriptName; - SynEdit.Highlighter := Form1.CurrHighlighter; + SynEdit.Highlighter := SimbaForm.CurrHighlighter; SynEdit.Options:= SynEdit.Options + [eoTabIndent] - [eoSmartTabs]; SynEdit.IncrementColor.Background := $30D070; SynEdit.HighlightAllColor.Background:= clYellow; @@ -640,11 +639,6 @@ begin // TSynPasSyn(SynEdit.Highlighter).NestedComments:= false; Does not work :( end; -destructor TScriptFrame.Destroy; -begin - inherited Destroy; -end; - initialization {$R *.lfm} diff --git a/Projects/SAMufasaGUI/psextension.pas b/Projects/Simba/psextension.pas similarity index 94% rename from Projects/SAMufasaGUI/psextension.pas rename to Projects/Simba/psextension.pas index f1d84fa..f6418ec 100644 --- a/Projects/SAMufasaGUI/psextension.pas +++ b/Projects/Simba/psextension.pas @@ -49,7 +49,7 @@ uses uPSC_extctrls,uPSC_menus, //Compile libs uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_extctrls,uPSR_menus, //Runtime-libs - testunit,updateform,settingssandbox,bitmaps,files,Dialogs, mmisc//Writeln + SimbaUnit,updateform,settingssandbox,bitmaps,files,Dialogs, mmisc//Writeln ; function TSimbaPSExtension.HookExists(const HookName: String): Boolean; @@ -119,10 +119,10 @@ procedure TSimbaPSExtension.RegisterMyMethods(Sender: TPSScript); begin Sender.Comp.AddTypes('TStringArray','Array of String'); Sender.Comp.AddConstantN('AppPath','string').SetString(MainDir + DirectorySeparator); - Sender.Comp.AddConstantN('IncludePath','string').SetString(Form1.IncludePath); - Sender.Comp.AddConstantN('PluginPath','string').SetString(Form1.PluginPath); - Sender.Comp.AddConstantN('FontPath','string').SetString(form1.FontPath); - Sender.Comp.AddConstantN('ExtPath','string').SetString(form1.ExtPath); + 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' @@ -146,8 +146,8 @@ end; procedure TSimbaPSExtension.OnPSExecute(Sender: TPSScript); begin - Sender.SetVarToInstance('simba',Form1); - Sender.SetVarToInstance('Simba_MainMenu',Form1.MainMenu); + Sender.SetVarToInstance('Simba',SimbaForm); + Sender.SetVarToInstance('Simba_MainMenu',SimbaForm.MainMenu); Sender.SetPointerToData('Settings',@Self.Settings,Sender.FindNamedType('TMMLSettingsSandbox')); end; diff --git a/Projects/SAMufasaGUI/simbasettings.lfm b/Projects/Simba/simbasettings.lfm similarity index 100% rename from Projects/SAMufasaGUI/simbasettings.lfm rename to Projects/Simba/simbasettings.lfm diff --git a/Projects/SAMufasaGUI/simbasettings.pas b/Projects/Simba/simbasettings.pas similarity index 99% rename from Projects/SAMufasaGUI/simbasettings.pas rename to Projects/Simba/simbasettings.pas index bc5cb89..870e672 100644 --- a/Projects/SAMufasaGUI/simbasettings.pas +++ b/Projects/Simba/simbasettings.pas @@ -1,4 +1,4 @@ -unit simbasettings; +unit Simbasettings; {$mode objfpc}{$H+} diff --git a/Projects/SAMufasaGUI/testunit.lfm b/Projects/Simba/simbaunit.lfm similarity index 99% rename from Projects/SAMufasaGUI/testunit.lfm rename to Projects/Simba/simbaunit.lfm index 97a5162..d207d31 100644 --- a/Projects/SAMufasaGUI/testunit.lfm +++ b/Projects/Simba/simbaunit.lfm @@ -1,10 +1,10 @@ -object Form1: TForm1 - Left = 150 +object SimbaForm: TSimbaForm + Left = 143 Height = 623 - Top = 69 + Top = 115 Width = 660 AllowDropFiles = True - Caption = 'THA FUKING SIMBA' + Caption = 'THA FUKING Simba' ClientHeight = 603 ClientWidth = 660 KeyPreview = True @@ -437,15 +437,12 @@ object Form1: TForm1 TabOrder = 3 inherited FunctionList: TTreeView Height = 323 - Top = 18 Width = 150 - DefaultItemHeight = 15 OnChange = FunctionListChange OnEnter = FunctionListEnter OnExit = FunctionListExit end inherited editSearchList: TEdit - Height = 21 Top = 341 Width = 150 OnExit = editSearchListExit @@ -453,7 +450,6 @@ object Form1: TForm1 OnKeyPress = editSearchListKeyPress end inherited FunctionListLabel: TLabel - Height = 14 Width = 146 end end @@ -802,6 +798,7 @@ object Form1: TForm1 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF006D9CD4896A9AD2FB6697CFEE } + ShortCut = 16465 OnClick = ActionExitExecute end end @@ -1352,6 +1349,10 @@ object Form1: TForm1 Caption = 'Settings' OnClick = MenuItemSettingsButtonClick end + object MenuItemBitmapConv: TMenuItem + Caption = '&Bitmap conversion' + OnClick = MenuItemBitmapConvClick + end object MenuItemDivider10: TMenuItem Caption = '-' end diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/Simba/simbaunit.pas similarity index 87% rename from Projects/SAMufasaGUI/testunit.pas rename to Projects/Simba/simbaunit.pas index 3d0ad7d..25992a3 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/Simba/simbaunit.pas @@ -18,10 +18,10 @@ See the file COPYING, included in this distribution, for details about the copyright. - TestUnit/GUI for the Mufasa Macro Library + Simba/GUI for the Mufasa Macro Library } -unit TestUnit; +unit SimbaUnit; {$undef EditButtons} {$Undef ProcessMessages} //Define this for processmessages in ThreadSafeCall @@ -41,12 +41,12 @@ uses SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynEditMarkupHighAll, LMessages, Buttons,mmisc, stringutil,mufasatypesutil,mufasabase, v_ideCodeParser, - about, framefunctionlist, ocr, updateform, simbasettings, psextension, virtualextension, + about, framefunctionlist, ocr, updateform, Simbasettings, psextension, virtualextension, extensionmanager, settingssandbox, v_ideCodeInsight, CastaliaPasLexTypes, CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; const - SimbaVersion = 650; + SimbaVersion = 668; type @@ -64,9 +64,9 @@ type end; // Tab - { TForm1 } + { TSimbaForm } - TForm1 = class(TForm) + TSimbaForm = class(TForm) ActionConsole: TAction; ActionNormalSize: TAction; ActionCompileScript: TAction; @@ -104,6 +104,7 @@ type MenuFile: TMenuItem; MenuEdit: TMenuItem; MenuHelp: TMenuItem; + MenuItemBitmapConv: TMenuItem; MenuItemExtensions: TMenuItem; MenuItemSettingsButton: TMenuItem; MenuItemDivider10: TMenuItem; @@ -258,6 +259,7 @@ type procedure FunctionListEnter(Sender: TObject); procedure FunctionListExit(Sender: TObject); procedure FunctionListTimerTimer(Sender: TObject); + procedure MenuItemBitmapConvClick(Sender: TObject); procedure MenuItemExtensionsClick(Sender: TObject); procedure MenuItemHandbookClick(Sender: TObject); procedure MenuItemColourHistoryClick(Sender: TObject); @@ -445,7 +447,7 @@ const Image_Stop = 7; Image_Terminate = 19; var - Form1: TForm1; + SimbaForm: TSimbaForm; MainDir : string; {$ifdef MSWindows} PrevWndProc : WNDPROC; @@ -459,6 +461,7 @@ uses debugimage, files, InterfaceBase, + bitmapconv, extensionmanagergui, colourhistory, math; @@ -466,7 +469,7 @@ uses {$ifdef mswindows} function ConsoleHandler( eventType : DWord) : WINBOOL;stdcall; begin - TThread.Synchronize(nil,@Form1.Close); + TThread.Synchronize(nil,@SimbaForm.Close); Result := true; end; @@ -476,7 +479,7 @@ function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; begin if uMsg = WM_HOTKEY then begin - Form1.ActionStopScript.Execute; + SimbaForm.ActionStopScript.Execute; Result := 0; end else Result := Windows.CallWindowProc(PrevWndProc,Ahwnd, uMsg, WParam, LParam); @@ -487,7 +490,7 @@ end; var DebugCriticalSection: syncobjs.TCriticalSection; -procedure TForm1.OnCCMessage(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer); +procedure TSimbaForm.OnCCMessage(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer); begin if (Typ = meNotSupported) then Exit; @@ -497,7 +500,7 @@ begin mDebugLn('ERROR: '+Format('%d:%d %s', [Y + 1, X, Msg])+' in '+TCodeInsight(Sender).FileName); end; -procedure TForm1.OnCompleteCode(Str: string); +procedure TSimbaForm.OnCompleteCode(Str: string); var sp, ep: Integer; s: string; @@ -516,7 +519,7 @@ begin end; end; -function TForm1.OnCCFindInclude(Sender: TObject; var FileName: string): Boolean; +function TSimbaForm.OnCCFindInclude(Sender: TObject; var FileName: string): Boolean; var Temp : string; begin @@ -529,7 +532,7 @@ begin result := false; end; -procedure TForm1.HandleConnectionData; +procedure TSimbaForm.HandleConnectionData; var Args : TVariantArray; begin @@ -546,12 +549,12 @@ begin end; end; -function TForm1.GetScriptPath: string; +function TSimbaForm.GetScriptPath: string; begin result :=IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Scripts/Path', ExpandFileName(MainDir+DS+'Scripts' + DS))); end; -procedure TForm1.HandleOpenFileData; +procedure TSimbaForm.HandleOpenFileData; var Args : TVariantArray; begin @@ -568,7 +571,7 @@ begin end; end; -procedure TForm1.HandleWriteFileData; +procedure TSimbaForm.HandleWriteFileData; var Args : TVariantArray; begin @@ -585,7 +588,7 @@ begin end; end; -procedure TForm1.HandleScriptStartData; +procedure TSimbaForm.HandleScriptStartData; var Args : TVariantArray; begin @@ -602,7 +605,7 @@ begin end; end; -procedure TForm1.ProcessDebugStream(Sender: TObject); +procedure TSimbaForm.ProcessDebugStream(Sender: TObject); begin if length(DebugStream) = 0 then Exit; @@ -620,7 +623,7 @@ begin end; end; -procedure TForm1.RecentFileItemsClick(Sender: TObject); +procedure TSimbaForm.RecentFileItemsClick(Sender: TObject); var i : integer; begin @@ -632,7 +635,7 @@ begin end; end; -procedure TForm1.ScriptPanelDockDrop(Sender: TObject; Source: TDragDockObject; +procedure TSimbaForm.ScriptPanelDockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer); begin if(X <= (ScriptPanel.Width div 2))then @@ -655,7 +658,7 @@ begin SplitterFunctionList.Show; end; -procedure TForm1.ScriptPanelDockOver(Sender: TObject; Source: TDragDockObject; //is there a better way to do all of this? +procedure TSimbaForm.ScriptPanelDockOver(Sender: TObject; Source: TDragDockObject; //is there a better way to do all of this? X, Y: Integer; State: TDragState; var Accept: Boolean); var P: TPoint; @@ -671,29 +674,29 @@ begin end; end; -procedure TForm1.ScriptPopupPopup(Sender: TObject); +procedure TSimbaForm.ScriptPopupPopup(Sender: TObject); begin SetEditActions; end; -procedure TForm1.SpeedButtonSearchClick(Sender: TObject); +procedure TSimbaForm.SpeedButtonSearchClick(Sender: TObject); begin CloseFindPanel; end; -procedure TForm1.SplitterFunctionListCanResize(Sender: TObject; var NewSize: Integer; +procedure TSimbaForm.SplitterFunctionListCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin if(NewSize > ScriptPanel.Width div 2)then NewSize := ScriptPanel.Width div 2; end; -procedure TForm1.TB_ReloadPluginsClick(Sender: TObject); +procedure TSimbaForm.TB_ReloadPluginsClick(Sender: TObject); begin // PluginsGlob.FreePlugins; end; -procedure TForm1.ThreadOpenConnectionEvent(Sender: TObject; var url: string;var Continue: boolean); +procedure TSimbaForm.ThreadOpenConnectionEvent(Sender: TObject; var url: string;var Continue: boolean); begin OpenConnectionData.Sender := Sender; OpenConnectionData.URL:= @URL; @@ -701,7 +704,7 @@ begin TThread.Synchronize(nil,@HandleConnectionData); end; -procedure TForm1.ThreadOpenFileEvent(Sender: TObject; var Filename: string; +procedure TSimbaForm.ThreadOpenFileEvent(Sender: TObject; var Filename: string; var Continue: boolean); begin OpenFileData.Sender := Sender; @@ -710,7 +713,7 @@ begin TThread.Synchronize(nil,@HandleOpenFileData); end; -procedure TForm1.ThreadWriteFileEvent(Sender: TObject; var Filename: string; +procedure TSimbaForm.ThreadWriteFileEvent(Sender: TObject; var Filename: string; var Continue: boolean); begin WriteFileData.Sender := Sender; @@ -719,24 +722,24 @@ begin TThread.Synchronize(nil,@HandleWriteFileData); end; -procedure TForm1.TrayPopupPopup(Sender: TObject); +procedure TSimbaForm.TrayPopupPopup(Sender: TObject); begin - MenuItemHide.enabled:= Form1.Visible; + MenuItemHide.enabled:= SimbaForm.Visible; {$ifdef MSWindows} - MenuItemShow.Enabled:= not Form1.Visible; - if Form1.Visible then - if Form1.CanFocus then - form1.SetFocus; + MenuItemShow.Enabled:= not SimbaForm.Visible; + if SimbaForm.Visible then + if SimbaForm.CanFocus then + SimbaForm.SetFocus; {$endif} end; -procedure TForm1.TT_UpdateClick(Sender: TObject); +procedure TSimbaForm.TT_UpdateClick(Sender: TObject); begin SimbaUpdateForm.ShowModal; TT_Update.Visible:=False; end; -procedure TForm1.UpdateTimerCheck(Sender: TObject); +procedure TSimbaForm.UpdateTimerCheck(Sender: TObject); var chk: String; time:integer; @@ -764,7 +767,7 @@ begin UpdateTimer.Interval:= time {mins} * 60 {secs} * 1000 {ms};//Every half hour end; -procedure TForm1.UpdateMenuButtonClick(Sender: TObject); +procedure TSimbaForm.UpdateMenuButtonClick(Sender: TObject); begin SimbaUpdateForm.ShowModal; end; @@ -772,9 +775,9 @@ end; procedure ClearDebug; begin {$IFNDEF MSWINDOWS} - Form1.ProcessDebugStream(nil); + SimbaForm.ProcessDebugStream(nil); {$ENDIF} - TThread.Synchronize(nil,@Form1.Memo1.Clear); + TThread.Synchronize(nil,@SimbaForm.Memo1.Clear); end; procedure formWriteln( S : String); @@ -782,12 +785,12 @@ begin mDebugLn('formWriteln: ' + s); {$ifdef MSWindows} //Ha, we cán acces the debugmemo - Form1.Memo1.Lines.Add(s); + SimbaForm.Memo1.Lines.Add(s); {$else} DebugCriticalSection.Enter; try s := s + MEOL; - Form1.DebugStream:= Form1.DebugStream + s; + SimbaForm.DebugStream:= SimbaForm.DebugStream + s; finally DebugCriticalSection.Leave; end; @@ -796,7 +799,7 @@ end; //{$ENDIF} -procedure TForm1.RunScript; +procedure TSimbaForm.RunScript; begin with CurrScript do begin @@ -821,7 +824,7 @@ begin end; end; -procedure TForm1.PauseScript; +procedure TSimbaForm.PauseScript; begin with CurrScript do begin; @@ -841,7 +844,7 @@ begin end; end; -procedure TForm1.StopScript; +procedure TSimbaForm.StopScript; begin with CurrScript do begin; @@ -869,7 +872,7 @@ begin end; end; -procedure TForm1.AddTab; +procedure TSimbaForm.AddTab; var Tab : TMufasaTab; begin; @@ -886,7 +889,7 @@ begin; end; end; -function TForm1.DeleteTab(TabIndex: integer; CloseLast : boolean; Silent : boolean = false) : boolean; +function TSimbaForm.DeleteTab(TabIndex: integer; CloseLast : boolean; Silent : boolean = false) : boolean; var Tab : TMufasaTab; OldIndex : integer;//So that we can switch back, if needed. @@ -931,12 +934,12 @@ begin RefreshTab; end; -procedure TForm1.ClearTab(TabIndex: integer); +procedure TSimbaForm.ClearTab(TabIndex: integer); begin TMufasaTab(Tabs[TabIndex]).Clear; end; -procedure TForm1.CloseTabs(Exclude: integer = -1; Silent : boolean = false); +procedure TSimbaForm.CloseTabs(Exclude: integer = -1; Silent : boolean = false); var I : integer; begin @@ -946,7 +949,7 @@ begin exit; end; -procedure TForm1.SetEditActions; +procedure TSimbaForm.SetEditActions; procedure EditActions(Undo,Redo,Cut,Copy,Paste,Delete : boolean); begin; ActionUndo.Enabled:= Undo; @@ -994,7 +997,7 @@ begin EditActions(false,false,false,false,false,false); end; -procedure TForm1.DoSearch(Next: boolean; HighlightAll : boolean); +procedure TSimbaForm.DoSearch(Next: boolean; HighlightAll : boolean); var Res : integer; CurrPos : TPoint; @@ -1052,7 +1055,7 @@ begin end; end; -procedure TForm1.RefreshTab; +procedure TSimbaForm.RefreshTab; var Tab : TMufasaTab; Script : TScriptFrame; @@ -1100,12 +1103,12 @@ begin SetEditActions; end; -procedure TForm1.RefreshTabSender(sender: PtrInt); +procedure TSimbaForm.RefreshTabSender(sender: PtrInt); begin RefreshTab; end; -procedure TForm1.CreateDefaultEnvironment; +procedure TSimbaForm.CreateDefaultEnvironment; var PluginsPath,extensionsPath : string; begin @@ -1130,7 +1133,7 @@ begin CreateSetting('Settings/Fonts/VersionLink', FontURL + 'Version'); CreateSetting('Settings/Fonts/UpdateLink', FontURL + 'Fonts.tar.bz2'); - CreateSetting('Settings/News/URL', 'http://simba.villavu.com/bin/news'); + CreateSetting('Settings/News/URL', 'http://Simba.villavu.com/bin/news'); {Creates the paths and returns the path} PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS)); @@ -1160,7 +1163,7 @@ begin UpdateTimer.Interval:=25; end; -procedure TForm1.LoadFormSettings; +procedure TSimbaForm.LoadFormSettings; var str,str2 : string; Data : TStringArray; @@ -1210,7 +1213,7 @@ begin self.EndFormUpdate; end; -procedure TForm1.SaveFormSettings; +procedure TSimbaForm.SaveFormSettings; var Data : TStringArray; path : string; @@ -1256,7 +1259,7 @@ begin end; end; -procedure TForm1.LoadExtensions; +procedure TSimbaForm.LoadExtensions; var extCount : integer; function LoadExtension(Number : integer) : boolean; @@ -1306,7 +1309,7 @@ begin ExtManager.LoadPSExtensionsDir(str,str2); end; -procedure TForm1.AddRecentFile(const filename: string); +procedure TSimbaForm.AddRecentFile(const filename: string); var MaxRecentFiles : integer; Len,i : integer; @@ -1330,7 +1333,7 @@ begin RecentFileItems[len - 1-i].Caption:= ExtractFileName(RecentFiles[i]); end; -procedure TForm1.InitalizeTMThread(var Thread: TMThread); +procedure TSimbaForm.InitalizeTMThread(var Thread: TMThread); var DbgImgInfo : TDbgImgInfo; AppPath : string; @@ -1412,27 +1415,39 @@ begin Thread.OpenFileEvent:=@ThreadOpenFileEvent; end; -procedure TForm1.HandleParameters; +procedure TSimbaForm.HandleParameters; var DoRun : Boolean; ErrorMsg : string; begin DoRun := false; - if Paramcount = 1 then + // paramcount = 1 means we got only one parameter. We assume this to be a file. + // and try to open it accordingly + if (Paramcount = 1) and not (Application.HasOption('open')) then begin + writeln('Opening file: ' + ParamStr(1)); if FileExists(ParamStr(1)) then + begin LoadScriptFile(paramstr(1)); + end; end else - begin; - ErrorMsg:=Application.CheckOptions('ro:','run open:'); + // we have more parameters. Check for specific options. (-r -o, --run --open) + begin + ErrorMsg:=Application.CheckOptions('ro:',['run', 'open:']); if ErrorMsg <> '' then - mDebugLn(ErrorMSG) - else + begin + mDebugLn('ERROR IN COMMAND LINE ARGS: ' + ErrorMSG) + end else begin if Application.HasOption('o','open') then - begin; + begin + writeln('Opening file: ' + Application.GetOptionValue('o','open')); LoadScriptFile(Application.GetOptionValue('o','open')); DoRun:= Application.HasOption('r','run'); + end else + // no valid options + begin + writeln('No valid command line args are passed'); end; end; end; @@ -1440,7 +1455,7 @@ begin Self.RunScript; end; -procedure TForm1.OnSaveScript(const Filename: string); +procedure TSimbaForm.OnSaveScript(const Filename: string); begin with CurrScript do begin @@ -1460,7 +1475,7 @@ begin end; -procedure TForm1.ActionTabLastExecute(Sender: TObject); +procedure TSimbaForm.ActionTabLastExecute(Sender: TObject); var CurrIndex : integer; begin @@ -1472,7 +1487,7 @@ begin PageControl1.TabIndex:= CurrIndex; end; -procedure TForm1.ActionCloseTabExecute(Sender: TObject); +procedure TSimbaForm.ActionCloseTabExecute(Sender: TObject); begin if(PageControl1.PageCount > 1)then Self.DeleteTab(PageControl1.TabIndex,false) @@ -1480,7 +1495,7 @@ begin Self.ClearScript; //DeleteTab would take care of this already, but yeah, it's neater this way. end; -procedure TForm1.ActionCompileScriptExecute(Sender: TObject); +procedure TSimbaForm.ActionCompileScriptExecute(Sender: TObject); var TempThread : TMThread; begin @@ -1489,14 +1504,14 @@ begin TempThread.Resume; end; -procedure TForm1.ActionConsoleExecute(Sender: TObject); +procedure TSimbaForm.ActionConsoleExecute(Sender: TObject); begin {$ifdef mswindows} ShowConsole(not ConsoleVisible); {$endif} end; -procedure TForm1.ActionCopyExecute(Sender: TObject); +procedure TSimbaForm.ActionCopyExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.CopyToClipboard @@ -1504,7 +1519,7 @@ begin Memo1.CopyToClipboard; end; -procedure TForm1.ActionCutExecute(Sender: TObject); +procedure TSimbaForm.ActionCutExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.CutToClipboard @@ -1512,7 +1527,7 @@ begin Memo1.CutToClipboard; end; -procedure TForm1.ActionDeleteExecute(Sender: TObject); +procedure TSimbaForm.ActionDeleteExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.ClearSelection @@ -1520,17 +1535,17 @@ begin Memo1.ClearSelection; end; -procedure TForm1.ActionExitExecute(Sender: TObject); +procedure TSimbaForm.ActionExitExecute(Sender: TObject); begin Self.Close; end; -procedure TForm1.ActionFindNextExecute(Sender: TObject); +procedure TSimbaForm.ActionFindNextExecute(Sender: TObject); begin DoSearch(true, false); end; -procedure TForm1.ActionFindstartExecute(Sender: TObject); +procedure TSimbaForm.ActionFindstartExecute(Sender: TObject); begin if frmFunctionList.Focused or frmFunctionList.FunctionList.Focused or frmFunctionList.editSearchList.Focused then begin @@ -1544,23 +1559,23 @@ begin end; end; -procedure TForm1.ActionClearDebugExecute(Sender: TObject); +procedure TSimbaForm.ActionClearDebugExecute(Sender: TObject); begin Memo1.Clear; end; -procedure TForm1.ActionNewExecute(Sender: TObject); +procedure TSimbaForm.ActionNewExecute(Sender: TObject); begin //Self.ClearScript; Self.AddTab; end; -procedure TForm1.ActionNewTabExecute(Sender: TObject); +procedure TSimbaForm.ActionNewTabExecute(Sender: TObject); begin Self.AddTab; end; -procedure TForm1.ActionNormalSizeExecute(Sender: TObject); +procedure TSimbaForm.ActionNormalSizeExecute(Sender: TObject); var SizeStr : string; Data : TStringArray; @@ -1578,12 +1593,12 @@ begin end; end; -procedure TForm1.ActionOpenExecute(Sender: TObject); +procedure TSimbaForm.ActionOpenExecute(Sender: TObject); begin Self.OpenScript; end; -procedure TForm1.ActionPasteExecute(Sender: TObject); +procedure TSimbaForm.ActionPasteExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.PasteFromClipboard @@ -1596,12 +1611,12 @@ begin end; -procedure TForm1.ActionPauseExecute(Sender: TObject); +procedure TSimbaForm.ActionPauseExecute(Sender: TObject); begin Self.PauseScript; end; -procedure TForm1.ActionRedoExecute(Sender: TObject); +procedure TSimbaForm.ActionRedoExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.Redo @@ -1609,19 +1624,19 @@ begin Memo1.Undo; //? end; -procedure TForm1.ActionReplaceExecute(Sender: TObject); +procedure TSimbaForm.ActionReplaceExecute(Sender: TObject); begin if(ScriptPopup.HandleAllocated)then dlgReplace.FindText:= CurrScript.SynEdit.SelText; dlgReplace.Execute; end; -procedure TForm1.ActionRunExecute(Sender: TObject); +procedure TSimbaForm.ActionRunExecute(Sender: TObject); begin Self.RunScript; end; -procedure TForm1.ActionSaveAllExecute(Sender: TObject); +procedure TSimbaForm.ActionSaveAllExecute(Sender: TObject); var i : integer; OldIndex : integer; @@ -1635,17 +1650,17 @@ begin PageControl1.TabIndex:= oldindex; end; -procedure TForm1.ActionSaveAsExecute(Sender: TObject); +procedure TSimbaForm.ActionSaveAsExecute(Sender: TObject); begin Self.SaveCurrentScriptAs; end; -procedure TForm1.ActionSaveExecute(Sender: TObject); +procedure TSimbaForm.ActionSaveExecute(Sender: TObject); begin Self.SaveCurrentScript; end; -procedure TForm1.ActionSelectAllExecute(Sender: TObject); +procedure TSimbaForm.ActionSelectAllExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.SynEdit.SelectAll @@ -1656,12 +1671,12 @@ begin end; -procedure TForm1.ActionStopExecute(Sender: TObject); +procedure TSimbaForm.ActionStopExecute(Sender: TObject); begin Self.StopScript; end; -procedure TForm1.ActionTabNextExecute(Sender: TObject); +procedure TSimbaForm.ActionTabNextExecute(Sender: TObject); var CurrIndex : integer; begin @@ -1673,7 +1688,7 @@ begin PageControl1.TabIndex:= CurrIndex; end; -procedure TForm1.ActionUndoExecute(Sender: TObject); +procedure TSimbaForm.ActionUndoExecute(Sender: TObject); begin if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then CurrScript.Undo @@ -1681,7 +1696,7 @@ begin Memo1.Undo; end; -procedure TForm1.ChangeMouseStatus(Sender: TObject); +procedure TSimbaForm.ChangeMouseStatus(Sender: TObject); var x, y: Integer; begin @@ -1697,7 +1712,7 @@ begin StatusBar.Panels[Panel_Coords].Text := Format('(%d, %d)', [x, y]); end; -procedure TForm1.CheckBoxMatchCaseClick(Sender: TObject); +procedure TSimbaForm.CheckBoxMatchCaseClick(Sender: TObject); begin RefreshTab; CurrScript.SynEdit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable; @@ -1709,7 +1724,7 @@ end; -procedure TForm1.CloseFindPanel; +procedure TSimbaForm.CloseFindPanel; begin SearchPanel.Visible:= false; if CurrScript.SynEdit.CanFocus then @@ -1720,13 +1735,13 @@ end; If we are being sent to the background; then minimize other active windows as well. } -procedure TForm1.doOnHide(Sender: TObject); +procedure TSimbaForm.doOnHide(Sender: TObject); begin if DebugImgForm.Visible then DebugImgForm.Hide; end; -procedure TForm1.StopCodeCompletion; +procedure TSimbaForm.StopCodeCompletion; begin CodeCompletionForm.Hide; if frmFunctionList.InCodeCompletion then @@ -1748,12 +1763,12 @@ begin end; end; -function TForm1.FindTab(filename: string): integer; +function TSimbaForm.FindTab(filename: string): integer; var i : integer; begin FileName := SetDirSeparators(filename); - for i := 0 to Form1.Tabs.Count - 1 do + for i := 0 to SimbaForm.Tabs.Count - 1 do {$ifdef MSWindows} //Case insensitive if lowercase(TMufasaTab(Tabs[i]).ScriptFrame.ScriptFile) = lowercase(filename) then {$else} @@ -1763,13 +1778,13 @@ begin result := -1; end; -procedure TForm1.editSearchListExit(Sender: TObject); +procedure TSimbaForm.editSearchListExit(Sender: TObject); begin frmFunctionList.editSearchList.Color := clWhite; StopCodeCompletion; end; -procedure TForm1.editSearchListKeyDown(Sender: TObject; var Key: Word; +procedure TSimbaForm.editSearchListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if key = vk_up then @@ -1784,7 +1799,7 @@ begin end; end; -procedure TForm1.editSearchListKeyPress(Sender: TObject; var Key: char); +procedure TSimbaForm.editSearchListKeyPress(Sender: TObject; var Key: char); var linetext : string; begin @@ -1819,7 +1834,7 @@ begin end; end; -procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String +procedure TSimbaForm.FormDropFiles(Sender: TObject; const FileNames: array of String ); var i : integer; @@ -1845,7 +1860,7 @@ begin {$EndIf}; end; -procedure TForm1.FunctionListChange(Sender: TObject; Node: TTreeNode); +procedure TSimbaForm.FunctionListChange(Sender: TObject; Node: TTreeNode); var MethodInfo : TMethodInfo; begin @@ -1860,33 +1875,42 @@ begin end; end; -procedure TForm1.FunctionListEnter(Sender: TObject); +procedure TSimbaForm.FunctionListEnter(Sender: TObject); begin frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text); end; -procedure TForm1.FunctionListExit(Sender: TObject); +procedure TSimbaForm.FunctionListExit(Sender: TObject); begin // StatusBar.Panels[2].Text:= ''; end; -procedure TForm1.FunctionListTimerTimer(Sender: TObject); +procedure TSimbaForm.FunctionListTimerTimer(Sender: TObject); begin if Self.Visible and (CurrScript <> nil) then frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text); end; -procedure TForm1.MenuItemExtensionsClick(Sender: TObject); +procedure TSimbaForm.MenuItemBitmapConvClick(Sender: TObject); begin - ExtensionsForm.Show; + BitmapConvForm.Show; end; -procedure TForm1.MenuItemHandbookClick(Sender: TObject); +procedure TSimbaForm.MenuItemExtensionsClick(Sender: TObject); begin - OpenURL('http://wizzup.org/static/simba/doc/ps_handbook/'); + MenuItemExtensions.Checked := not ExtensionsForm.Visible; + if MenuItemExtensions.Checked then + ExtensionsForm.Show + else + ExtensionsForm.Hide; end; -procedure TForm1.MenuItemColourHistoryClick(Sender: TObject); +procedure TSimbaForm.MenuItemHandbookClick(Sender: TObject); +begin + OpenURL('http://wizzup.org/static/Simba/doc/ps_handbook/'); +end; + +procedure TSimbaForm.MenuItemColourHistoryClick(Sender: TObject); begin MenuItemColourHistory.Checked := not ColourHistoryForm.Visible; if MenuItemColourHistory.Checked then @@ -1895,13 +1919,13 @@ begin ColourHistoryForm.Hide; end; -procedure TForm1.dlgReplaceFind(Sender: TObject); +procedure TSimbaForm.dlgReplaceFind(Sender: TObject); begin SearchString := dlgReplace.FindText; DoSearch(True, False); end; -procedure TForm1.dlgReplaceReplace(Sender: TObject); +procedure TSimbaForm.dlgReplaceReplace(Sender: TObject); var SOptions: TSynSearchOptions; P: TPoint; @@ -1940,13 +1964,13 @@ begin end; end; -procedure TForm1.EditSearchChange(Sender: TObject); +procedure TSimbaForm.EditSearchChange(Sender: TObject); begin SearchString :=LabeledEditSearch.Text; DoSearch(false, true); end; -procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction); +procedure TSimbaForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); var i : integer; begin @@ -1969,21 +1993,21 @@ var b: TStringList; ms: TMemoryStream; begin - if form1.UpdatingFonts then + if SimbaForm.UpdatingFonts then begin mDebugLn('Updating the fonts, thus waiting a bit till we init the OCR.'); - while form1.UpdatingFonts do + while SimbaForm.UpdatingFonts do begin if GetCurrentThreadId = MainThreadID then Application.ProcessMessages; sleep(25); end; end; - form1.InitalizeTMThread(t); + SimbaForm.InitalizeTMThread(t); KillThread(t.ThreadID); if (t is TPSThread) then try - a := TPSScriptExtension.Create(form1); + a := TPSScriptExtension.Create(SimbaForm); b := TStringList.Create; ms := TMemoryStream.Create; @@ -2003,7 +2027,7 @@ begin CoreBuffer[0] := TCodeInsight.Create; with CoreBuffer[0] do begin - OnMessage := @form1.OnCCMessage; + OnMessage := @SimbaForm.OnCCMessage; b.SaveToStream(ms); Run(ms, nil, -1, True); FileName := '"PSCORE"'; @@ -2018,7 +2042,7 @@ begin end; end; -procedure TForm1.FormCreate(Sender: TObject); +procedure TSimbaForm.FormCreate(Sender: TObject); var FillThread : TProcThread; begin @@ -2100,7 +2124,7 @@ begin self.EndFormUpdate; end; -procedure TForm1.FormDestroy(Sender: TObject); +procedure TSimbaForm.FormDestroy(Sender: TObject); var i : integer; begin @@ -2125,7 +2149,7 @@ begin {$endif} end; -procedure TForm1.FormShortCuts(var Msg: TLMKey; var Handled: Boolean); +procedure TSimbaForm.FormShortCuts(var Msg: TLMKey; var Handled: Boolean); begin SetEditActions; Handled := ActionList.IsShortCut(Msg); @@ -2133,7 +2157,7 @@ end; -procedure TForm1.LabeledEditSearchEnter(Sender: TObject); +procedure TSimbaForm.LabeledEditSearchEnter(Sender: TObject); begin SearchStart := CurrScript.SynEdit.LogicalCaretXY; with CurrScript.SynEdit do @@ -2143,13 +2167,13 @@ begin end; end; -procedure TForm1.LabeledEditSearchExit(Sender: TObject); +procedure TSimbaForm.LabeledEditSearchExit(Sender: TObject); begin if not CheckBoxMatchCase.MouseEntered then RefreshTab; end; -procedure TForm1.LabeledEditSearchKeyDown(Sender: TObject; var Key: Word; +procedure TSimbaForm.LabeledEditSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (ssCtrl in Shift) and (key = vk_f) then @@ -2163,7 +2187,7 @@ begin end; end; -procedure TForm1.LabeledEditSearchKeyPress(Sender: TObject; var Key: char); +procedure TSimbaForm.LabeledEditSearchKeyPress(Sender: TObject; var Key: char); begin if key = #13 then begin; @@ -2174,22 +2198,22 @@ begin end; end; -procedure TForm1.MenuEditClick(Sender: TObject); +procedure TSimbaForm.MenuEditClick(Sender: TObject); begin SetEditActions; end; -procedure TForm1.MenuItemAboutClick(Sender: TObject); +procedure TSimbaForm.MenuItemAboutClick(Sender: TObject); begin AboutForm.ShowModal; end; -procedure TForm1.MenuItemCloseTabsClick(Sender: TObject); +procedure TSimbaForm.MenuItemCloseTabsClick(Sender: TObject); begin Self.CloseTabs; end; -procedure TForm1.MenuItemDebugImageClick(Sender: TObject); +procedure TSimbaForm.MenuItemDebugImageClick(Sender: TObject); begin MenuItemDebugImage.Checked := not DebugImgForm.Visible; if MenuItemDebugImage.Checked then @@ -2198,7 +2222,7 @@ begin DebugImgForm.Hide; end; -procedure TForm1.MenuItemExportHTMLClick(Sender: TObject); +procedure TSimbaForm.MenuItemExportHTMLClick(Sender: TObject); var SynExporterHTML : TSynExporterHTML; begin; @@ -2227,7 +2251,7 @@ end; procedure formWritelnEx(S: String); begin - Form1.Memo1.Lines.Add(s); + SimbaForm.Memo1.Lines.Add(s); end; function GetMethodName( Decl : string; PlusNextChar : boolean) : string; @@ -2257,7 +2281,7 @@ begin; result := result + ';'; end; -procedure TForm1.MenuitemFillFunctionListClick(Sender: TObject); +procedure TSimbaForm.MenuitemFillFunctionListClick(Sender: TObject); var Methods : TExpMethodArr; LastSection : string; @@ -2312,7 +2336,7 @@ begin frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text); end; -procedure TForm1.MenuItemHideClick(Sender: TObject); +procedure TSimbaForm.MenuItemHideClick(Sender: TObject); begin if Self.Visible = false then MenuItemShowClick(sender) @@ -2320,49 +2344,49 @@ begin Self.Hide; end; -procedure TForm1.MenuItemReportBugClick(Sender: TObject); +procedure TSimbaForm.MenuItemReportBugClick(Sender: TObject); begin OpenURL('http://mufasa.villavu.com/mantis/bug_report_page.php'); end; -procedure TForm1.MenuItemSettingsButtonClick(Sender: TObject); +procedure TSimbaForm.MenuItemSettingsButtonClick(Sender: TObject); begin SettingsForm.ShowModal; end; -procedure TForm1.MenuItemShowClick(Sender: TObject); +procedure TSimbaForm.MenuItemShowClick(Sender: TObject); begin Self.Show; Self.WindowState := wsNormal; end; -procedure TForm1.MenuItemTabCloseClick(Sender: TObject); +procedure TSimbaForm.MenuItemTabCloseClick(Sender: TObject); begin DeleteTab(PopupTab,false); end; -procedure TForm1.MenuItemTabCloseOthersClick(Sender: TObject); +procedure TSimbaForm.MenuItemTabCloseOthersClick(Sender: TObject); begin CloseTabs(PopupTab); end; -procedure TForm1.MenuItemFunctionListClick(Sender: TObject); +procedure TSimbaForm.MenuItemFunctionListClick(Sender: TObject); begin FunctionListShown(not MenuItemFunctionList.Checked); end; -procedure TForm1.MTrayIconClick(Sender: TObject); +procedure TSimbaForm.MTrayIconClick(Sender: TObject); begin self.Show; if Self.CanFocus then self.SetFocus; end; -function TForm1.GetSimbaNews: String; +function TSimbaForm.GetSimbaNews: String; var t: TDownloadThread; begin - t := TDownloadThread.Create(LoadSettingDef('Settings/News/URL', 'http://simba.villavu.com/bin/news'), + t := TDownloadThread.Create(LoadSettingDef('Settings/News/URL', 'http://Simba.villavu.com/bin/news'), @Result); t.Resume; while not t.done do @@ -2372,12 +2396,12 @@ begin end; end; -procedure TForm1.SetExtPath(const AValue: string); +procedure TSimbaForm.SetExtPath(const AValue: string); begin SetSetting('Settings/Extensions/Path',AValue,true); end; -procedure TForm1.NewsTimerTimer(Sender: TObject); +procedure TSimbaForm.NewsTimerTimer(Sender: TObject); var s: String; News : TStringList; {Need it for correct EOL stuff} @@ -2391,7 +2415,7 @@ begin News.free; end; -procedure TForm1.OnLinePSScript(Sender: TObject); +procedure TSimbaForm.OnLinePSScript(Sender: TObject); begin {$IFDEF ProcessMessages} Application.ProcessMessages; //Don't think that this is neccesary though @@ -2400,7 +2424,7 @@ end; -procedure TForm1.ButtonPickClick(Sender: TObject); +procedure TSimbaForm.ButtonPickClick(Sender: TObject); var c, x, y: Integer; cobj: TColourPickerObject; @@ -2417,30 +2441,30 @@ begin end; -procedure TForm1.ButtonSelectorDown(Sender: TObject; Button: TMouseButton; +procedure TSimbaForm.ButtonSelectorDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Manager.SetTarget(Selector.Drag); FormWritelnEx('New window: ' + IntToStr(Selector.LastPick)); end; -procedure TForm1.PageControl1Change(Sender: TObject); +procedure TSimbaForm.PageControl1Change(Sender: TObject); begin RefreshTab(); end; -procedure TForm1.ButtonTrayClick(Sender: TObject); +procedure TSimbaForm.ButtonTrayClick(Sender: TObject); begin self.hide; end; -procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean +procedure TSimbaForm.PageControl1Changing(Sender: TObject; var AllowChange: Boolean ); begin LastTab:= PageControl1.TabIndex; end; -procedure TForm1.PageControl1ContextPopup(Sender: TObject; MousePos: TPoint; +procedure TSimbaForm.PageControl1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); begin PopupTab := PageControl1.TabIndexAtClientPos(MousePos); @@ -2451,7 +2475,7 @@ begin end; end; -procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); +procedure TSimbaForm.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); var NewPos : integer; OldPos : integer; @@ -2467,7 +2491,7 @@ begin end; end; -procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; +procedure TSimbaForm.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var Pos: Integer; @@ -2476,7 +2500,7 @@ begin Accept := (Pos <> PageControl1.TabIndex) and (Pos <> -1); end; -procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton; +procedure TSimbaForm.PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if(Button = mbLeft)then @@ -2488,7 +2512,7 @@ begin end; end; -procedure TForm1.PageControl1MouseUp(Sender: TObject; Button: TMouseButton; +procedure TSimbaForm.PageControl1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if(Button = mbMiddle) and (not(PageControl1.Dragging))then @@ -2496,7 +2520,7 @@ begin DeleteTab(PageControl1.TabIndexAtClientPos(Classes.Point(x,y)), False); end; -procedure TForm1.PickerPick(Sender: TObject; const Colour, colourx, +procedure TSimbaForm.PickerPick(Sender: TObject; const Colour, colourx, coloury: integer); var Args : TVariantArray; @@ -2508,38 +2532,38 @@ begin ExtManager.HandleHook(EventHooks[SExt_OnColourPick].HookName,Args); end; -procedure TForm1.PopupItemFindClick(Sender: TObject); +procedure TSimbaForm.PopupItemFindClick(Sender: TObject); begin SearchString := CurrScript.SynEdit.SelText; ActionFindNextExecute(ScriptPopup); end; -function TForm1.GetScriptState: TScriptState; +function TSimbaForm.GetScriptState: TScriptState; begin result := CurrScript.FScriptState; end; -function TForm1.GetShowHintAuto: boolean; +function TSimbaForm.GetShowHintAuto: boolean; begin Result := LowerCase(LoadSettingDef('Settings/CodeHints/ShowAutomatically','True')) = 'true'; end; -procedure TForm1.SetFontPath(const AValue: String); +procedure TSimbaForm.SetFontPath(const AValue: String); begin SetSetting('Settings/Fonts/Path',AValue,true); end; -function TForm1.GetFontPath: String; +function TSimbaForm.GetFontPath: String; begin Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Fonts/Path', ExpandFileName(MainDir+DS+'Fonts' + DS))); end; -function TForm1.GetExtPath: string; +function TSimbaForm.GetExtPath: string; begin result :=IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Extensions/Path', ExpandFileName(MainDir+DS+'Extensions' + DS))); end; -function TForm1.GetHighlighter: TSynCustomHighlighter; +function TSimbaForm.GetHighlighter: TSynCustomHighlighter; begin if lowercase(LoadSettingDef('Settings/SourceEditor/LazColors','True')) = 'true' then result := LazHighlighter @@ -2547,32 +2571,32 @@ begin result := SCARHighlighter; end; -function TForm1.GetIncludePath: String; +function TSimbaForm.GetIncludePath: String; begin Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Includes/Path', ExpandFileName(MainDir+DS+'Includes' + DS))); end; -function TForm1.GetPluginPath: string; +function TSimbaForm.GetPluginPath: string; begin Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Plugins/Path', ExpandFileName(MainDir+DS+'Plugins' + DS))); end; -procedure TForm1.SetIncludePath(const AValue: String); +procedure TSimbaForm.SetIncludePath(const AValue: String); begin SetSetting('Settings/Includes/Path',AValue,true); end; -procedure TForm1.SetPluginPath(const AValue: string); +procedure TSimbaForm.SetPluginPath(const AValue: string); begin SetSetting('Settings/Plugins/Path',AValue,true); end; -procedure TForm1.SetScriptPath(const AValue: string); +procedure TSimbaForm.SetScriptPath(const AValue: string); begin SetSetting('Settings/Scripts/Path',AValue,True); end; -procedure TForm1.SetScriptState(const State: TScriptState); +procedure TSimbaForm.SetScriptState(const State: TScriptState); begin CurrScript.FScriptState:= State; with Self.StatusBar.panels[Panel_State] do @@ -2600,17 +2624,17 @@ begin end; end; -function TForm1.LoadSettingDef(const Key,Def: string): string; +function TSimbaForm.LoadSettingDef(const Key,Def: string): string; begin result := SettingsForm.Settings.GetKeyValueDefLoad(Key,def,SimbaSettingsFile); end; -function TForm1.CreateSetting(const Key,Value: string): string; +function TSimbaForm.CreateSetting(const Key,Value: string): string; begin result := SettingsForm.Settings.GetKeyValueDef(Key,value); end; -procedure TForm1.SetSetting(const key,Value: string; save : boolean); +procedure TSimbaForm.SetSetting(const key,Value: string; save : boolean); begin //Creates the setting if needed SettingsForm.Settings.SetKeyValue(key,value); @@ -2618,12 +2642,12 @@ begin SettingsForm.Settings.SaveToXML(SimbaSettingsFile); end; -function TForm1.SettingExtists(const key: string): boolean; +function TSimbaForm.SettingExtists(const key: string): boolean; begin result :=SettingsForm.Settings.KeyExists(key); end; -procedure TForm1.FontUpdate; +procedure TSimbaForm.FontUpdate; procedure Idler; begin Application.ProcessMessages; @@ -2685,7 +2709,7 @@ begin UpdatingFonts := False; end; -procedure TForm1.ScriptStartEvent(Sender: TObject; var Script: string; +procedure TSimbaForm.ScriptStartEvent(Sender: TObject; var Script: string; var Continue: boolean); begin ScriptStartData.Sender:=Sender; @@ -2694,7 +2718,7 @@ begin TThread.Synchronize(nil,@HandleScriptStartData); end; -procedure TForm1.SetShowHintAuto(const AValue: boolean); +procedure TSimbaForm.SetShowHintAuto(const AValue: boolean); begin SetSetting('Settings/CodeHints/ShowAutomatically',Booltostr(AValue,true)); end; @@ -2702,7 +2726,7 @@ end; {$ifdef mswindows} function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow'; -procedure TForm1.ShowConsole(ShowIt: boolean); +procedure TSimbaForm.ShowConsole(ShowIt: boolean); var ProcessId : DWOrd; begin @@ -2722,7 +2746,7 @@ begin end; {$endif} -procedure TForm1.FunctionListShown(ShowIt: boolean); +procedure TSimbaForm.FunctionListShown(ShowIt: boolean); begin with MenuItemFunctionList, frmFunctionList do begin @@ -2754,7 +2778,7 @@ begin end; -procedure TForm1.SafeCallThread; +procedure TSimbaForm.SafeCallThread; var thread: TMThread; LocalCopy : TSyncInfo; @@ -2781,7 +2805,7 @@ begin end; end; -function TForm1.OpenScript: boolean; +function TSimbaForm.OpenScript: boolean; var OpenInNewTab : boolean; begin @@ -2792,7 +2816,7 @@ begin Exit; with TOpenDialog.Create(nil) do try - Filter:= 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' +LoadSettingDef('Settings/Extensions/FileExtension','sex')+ + Filter:= 'Simba Files|*.Simba;*.simb;*.cogat;*.mufa;*.txt;*.' +LoadSettingDef('Settings/Extensions/FileExtension','sex')+ '|Any files|*.*'; if Execute then if FileExists(filename) then @@ -2802,7 +2826,7 @@ begin end; end; -function TForm1.LoadScriptFile(filename: string; AlwaysOpenInNewTab: boolean; CheckOtherTabs : boolean +function TSimbaForm.LoadScriptFile(filename: string; AlwaysOpenInNewTab: boolean; CheckOtherTabs : boolean ): boolean; var OpenInNewTab : boolean; @@ -2846,7 +2870,7 @@ begin end; end; -function TForm1.SaveCurrentScript: boolean; +function TSimbaForm.SaveCurrentScript: boolean; begin with CurrScript do begin @@ -2867,21 +2891,21 @@ begin end; end; -function TForm1.SaveCurrentScriptAs: boolean; +function TSimbaForm.SaveCurrentScriptAs: boolean; var ScriptFile : string; begin Result := false; with TSaveDialog.Create(nil) do try - filter := 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' + + filter := 'Simba Files|*.Simba;*.simb;*.cogat;*.mufa;*.txt;*.' + LoadSettingDef('Settings/Extensions/FileExtension','sex')+ '|Any files|*.*'; if Execute then begin; if ExtractFileExt(FileName) = '' then begin; - ScriptFile := FileName + '.simba'; + ScriptFile := FileName + '.Simba'; end else ScriptFile := FileName; CurrScript.SynEdit.Lines.SaveToFile(ScriptFile); @@ -2892,7 +2916,7 @@ begin end; end; -function TForm1.CanExitOrOpen: boolean; +function TSimbaForm.CanExitOrOpen: boolean; begin; Self.Enabled := False;//We HAVE to answer the popup Result := True; @@ -2925,7 +2949,7 @@ begin; Self.SetFocus; end; -function TForm1.ClearScript: boolean; +function TSimbaForm.ClearScript: boolean; begin result := false; if CanExitOrOpen then @@ -2960,7 +2984,7 @@ end; destructor TMufasaTab.Destroy; begin - ScriptFrame.Free; +// ScriptFrame.Free; TabSheet.Free; inherited Destroy; end; diff --git a/Projects/SAMufasaGUI/simpleanalyzer.pas b/Projects/Simba/simpleanalyzer.pas similarity index 100% rename from Projects/SAMufasaGUI/simpleanalyzer.pas rename to Projects/Simba/simpleanalyzer.pas diff --git a/Projects/SAMufasaGUI/updateform.lfm b/Projects/Simba/updateform.lfm similarity index 100% rename from Projects/SAMufasaGUI/updateform.lfm rename to Projects/Simba/updateform.lfm diff --git a/Projects/SAMufasaGUI/updateform.pas b/Projects/Simba/updateform.pas similarity index 94% rename from Projects/SAMufasaGUI/updateform.pas rename to Projects/Simba/updateform.pas index 48880e1..c1dbc13 100644 --- a/Projects/SAMufasaGUI/updateform.pas +++ b/Projects/Simba/updateform.pas @@ -63,32 +63,32 @@ const DownloadSpeedTextEnded = 'Downloaded at %d kB/s'; SimbaURL = {$IFDEF WINDOWS} {$IFDEF CPUI386} - 'http://simba.villavu.com/bin/Windows/x86/Stable/' + 'http://Simba.villavu.com/bin/Windows/x86/Stable/' {$ELSE} - 'http://simba.villavu.com/bin/Windows/x86_64/Stable/' + 'http://Simba.villavu.com/bin/Windows/x86_64/Stable/' {$ENDIF} {$ELSE} {$IFDEF CPUI386} - 'http://simba.villavu.com/bin/Linux/x86/Stable/' + 'http://Simba.villavu.com/bin/Linux/x86/Stable/' {$ELSE} - 'http://simba.villavu.com/bin/Linux/x86_64/Stable/' + 'http://Simba.villavu.com/bin/Linux/x86_64/Stable/' {$ENDIF} {$ENDIF}; - FontURL = 'http://simba.villavu.com/bin/Fonts/'; + FontURL = 'http://Simba.villavu.com/bin/Fonts/'; var SimbaUpdateForm: TSimbaUpdateForm; implementation uses - internets, TestUnit, simbasettings,lclintf; + internets, SimbaUnit, Simbasettings,lclintf; function TSimbaUpdateForm.CanUpdate: Boolean; begin GetLatestSimbaVersion; - mDebugLn(format('Current Simba version: %d',[TestUnit.SimbaVersion])); + mDebugLn(format('Current Simba version: %d',[SimbaUnit.SimbaVersion])); mDebugLn('Latest Simba Version: ' + IntToStr(FSimbaVersion)); - Exit(testunit.SimbaVersion < FSimbaVersion); + Exit(SimbaUnit.SimbaVersion < FSimbaVersion); end; function TSimbaUpdateForm.GetLatestFontVersion: integer; diff --git a/Projects/SAMufasaGUI/virtualextension.pas b/Projects/Simba/virtualextension.pas similarity index 100% rename from Projects/SAMufasaGUI/virtualextension.pas rename to Projects/Simba/virtualextension.pas diff --git a/Units/MMLAddon/PSInc/Wrappers/file.inc b/Units/MMLAddon/PSInc/Wrappers/file.inc index bff5a67..9c7fdd2 100644 --- a/Units/MMLAddon/PSInc/Wrappers/file.inc +++ b/Units/MMLAddon/PSInc/Wrappers/file.inc @@ -81,6 +81,21 @@ begin result := CreateDir(directoryName); end; +function ps_ForceDirectores(const dir : string) : boolean; extdecl; +begin + result := ForceDirectories(dir); +end; + +function ps_GetFiles(const Path, Ext : string) : TStringArray;extdecl; +begin + result := GetFiles(path,ext); +end; + +function ps_GetDirectories(const path : string) : TStringArray;extdecl; +begin + result := GetDirectories(path); +end; + procedure ps_WriteINI(const Section, KeyName, NewString, FileName: string);extdecl; var tempini : TIniFile; diff --git a/Units/MMLAddon/PSInc/Wrappers/math.inc b/Units/MMLAddon/PSInc/Wrappers/math.inc index cdfecb9..4da3848 100644 --- a/Units/MMLAddon/PSInc/Wrappers/math.inc +++ b/Units/MMLAddon/PSInc/Wrappers/math.inc @@ -83,9 +83,9 @@ begin Result:=Random(Abs(aFrom-aTo))+Min(aTo,AFrom); end; -function ps_ArcTan2(x,y : extended) : extended; extdecl; +function ps_ArcTan2(y,x : extended) : extended; extdecl; begin - result := ArcTan2(x,y); + result := ArcTan2(y,x); end; procedure ps_IncEx(var x : integer; increase : integer); extdecl; @@ -164,12 +164,26 @@ begin result := ln(x); end; -function ps_inttohex(value : integer) : string; +function ps_inttohex(value : integer) : string; extdecl; begin result := IntToHex(value,1); end; -function ps_hextoint(hex : string) : integer; +function ps_hextoint(hex : string) : integer;extdecl; begin result := StrToInt('$' + hex); end; +function ps_sar(AValue : longint; shift : byte) : longint; extdecl; +begin; + Shift:=Shift and 31; + Result:=longint(dword(dword(dword(AValue) shr Shift) or (dword(longint(dword(0-dword(dword(AValue) shr 31)) and dword(longint(0-(ord(Shift<>0){ and 1}))))) shl (32-Shift)))); +end; +function ps_ror(num : longword; shift : byte) : LongWord; extdecl; +begin + result := RorDWord(num,shift); +end; + +function ps_rol(num : longword; shift : byte) : LongWord; extdecl; +begin + result := RolDWord(num,shift); +end; diff --git a/Units/MMLAddon/PSInc/Wrappers/other.inc b/Units/MMLAddon/PSInc/Wrappers/other.inc index 54a82ab..ade1915 100644 --- a/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/Units/MMLAddon/PSInc/Wrappers/other.inc @@ -158,6 +158,16 @@ procedure ps_HakunaMatata; extdecl; begin; OpenWebPage('http://www.youtube.com/v/ejEVczA8PLU&hl=en&fs=1&autoplay=1'); end; +procedure ps_Simba; extdecl; +begin + psWriteln(DecompressString(Base64Decode('9AoAAHicldU7b+0gDADgvdL9D+AisSDOTrpUvWvGuzNVOkMn9v72a942j6T1dJrEX7AxqRAXYaS9up3iz8suVxoMKe+'+ + 'NC6LGnbEhiCCfTzPfJ5cmgidj5J9MsezSQAyApGHGR17N9SpGoBj1tkuRkJHoAk3WeMfTC66GWbaTFtMAwZDPRjh73U4uCKGnRTh3NMK0mAjiXxA975iERASl'+ + 'QjfcRLBVS963TKCQDb0m8Brwwv1IKAWkErcipPNAC5+JdPmY62hE/O3L8yE+T4k4PpGwi2aiEIn25zcqKMQ1a6bgNtGN4kJqJ1tYeqFwrMNDcCFvKjMsWXLOK'+ + 'N19toPbBN2PmacG9BogFoW7CQD00JTHdZlLml1yQZiv8zzBxGlQzxoxlx+Gdjo8JQDMV8w/0UmCctC/PGZDIKKPFMIGOM8M5IlUyuMel05IwY3hiHoMTLJYdg'+ + 'RKvhJxsGt5wzKI8PApjpQTQmj5CkIRIO6S3REPXZjD1kyNGxABm60IxLkdu8HqQOaRmt0TcTVVFHzCdq2oX6ae2CMRuo/bWuhdHfMhfSI8PTE3xIjAuIRu7An'+ + 'hv0kN+e38+1GMPYH/hq1PcyKsywdWvI1n9Y4YXzsLydgSphI4G7i/AexYRTW2RJmBPqFqTcgtUW7T6dgQlwIDfrsIsyDCphcbot5eDPgviZ8Yt0S4Ne4Iuoy/H'+ + '+//1sR/NLyhCQ=='))); +end; function ps_Random(Int: integer): integer; extdecl; begin diff --git a/Units/MMLAddon/PSInc/Wrappers/strings.inc b/Units/MMLAddon/PSInc/Wrappers/strings.inc index ffb9a8c..9f22b86 100644 --- a/Units/MMLAddon/PSInc/Wrappers/strings.inc +++ b/Units/MMLAddon/PSInc/Wrappers/strings.inc @@ -1 +1 @@ -function ps_Format(const fmt : string;const args : array of const) : string; extdecl; begin; Result := Format(fmt,Args); end; function ps_Capitalize(str : string) : string;extdecl; begin result := Capitalize(str); end; function ps_ExtractFromStr( Str : string; Extract : StrExtr) : string; extdecl; begin result := extractfromstr(str,extract); end; function ps_BoolToStr(bool : boolean) : string; extdecl; begin; result := BoolToStr(bool,true); end; function ps_Replace(Text, FindStr, ReplaceStr: string; Flags: TReplaceFlags): string; extdecl; begin; result := StringReplace(Text,FindStr,ReplaceStr,Flags); end; function ps_IntToStr(int : integer) : string; extdecl; begin result := inttostr(int); end; function ps_FloatToStr(flt : extended) : string; extdecl; begin result := floattostr(flt); end; function ps_StrToInt(value: String): Integer; extdecl; begin result := StrToInt(value); end; function ps_StrToIntDef(value: String; default: Integer): Integer; extdecl; begin result := StrToIntDef(value,default); end; function ps_StrToFloat(value: String): Extended; extdecl; begin result := StrToFloat(value); end; function ps_StrToFloatDef(value: String; default: Extended): Extended; extdecl; begin result := StrToFloatDef(value,default); end; function ps_StrToBool(value: String): Boolean;extdecl; begin result := StrToBool(value); end; function ps_StrToBoolDef(value: String; default: Boolean): Boolean; extdecl; begin result := StrToBoolDef(value,default); end; function ps_Between(s1, s2, str: string): string; extdecl; var I,J : integer; begin; Result := ''; I := pos(s1,str); if I > 0 then begin; i := i + length(s1); j := posex(s2,str,i); if j > 0 then Result := copy(str,i,j-i); end; end; function ps_Implode(Glue : string; Pieces: TStringArray): string;extdecl; begin result := implode(glue,pieces); end; function ps_Explode(del, str: string): TStringArray;extdecl; begin result := Explode(del,str); end; procedure ps_ExplodeWrap(del, str: string; var res : TStringArray);extdecl; begin res := Explode(del,str); end; function ps_Padl(s: String; i: longInt): String;extdecl; begin result := StringOfChar(Char(' '), i - length(s)) + s; end; function ps_Padz(s: String; i: longInt): String;extdecl; begin result := StringOfChar(Char('0'), i - length(s)) + s; end; function ps_Padr(s: String; i: longInt): String;extdecl; begin result := s + StringOfChar(Char(' '), i - Length(s)); end; function ps_ExecRegExpr( const RegExpr, InputStr : String) : boolean;extdecl; begin result := execregexpr(RegExpr,InputStr); end; procedure ps_SplitRegExpr( const RegExpr, InputStr : String; Pieces : TStrings);extdecl; begin SplitRegExpr(RegExpr,InputStr,Pieces); end; function ps_ReplaceRegExpr( const RegExpr, InputStr, ReplaceStr : String; UseSubstitution : boolean) : String;extdecl; begin result := ReplaceRegExpr(RegExpr,InputStr,ReplaceStr,UseSubstitution); end; \ No newline at end of file +function ps_Format(const fmt : string;const args : array of const) : string; extdecl; begin; Result := Format(fmt,Args); end; function ps_Capitalize(str : string) : string;extdecl; begin result := Capitalize(str); end; function ps_CompressString(const Str : string) : string; extdecl; begin result := CompressString(str); end; function ps_DecompressString(const Compressed : string) : string; extdecl; begin result := DecompressString(Compressed); end; function ps_Base64Encode(const str : string) : string; extdecl; begin result := Base64Encode(str); end; function ps_Base64Decode(const str : string) : string; extdecl; begin result := Base64Decode(str); end; function ps_ExtractFromStr( Str : string; Extract : StrExtr) : string; extdecl; begin result := extractfromstr(str,extract); end; function ps_BoolToStr(bool : boolean) : string; extdecl; begin; result := BoolToStr(bool,true); end; function ps_Replace(Text, FindStr, ReplaceStr: string; Flags: TReplaceFlags): string; extdecl; begin; result := StringReplace(Text,FindStr,ReplaceStr,Flags); end; function ps_IntToStr(int : integer) : string; extdecl; begin result := inttostr(int); end; function ps_FloatToStr(flt : extended) : string; extdecl; begin result := floattostr(flt); end; function ps_StrToInt(value: String): Integer; extdecl; begin result := StrToInt(value); end; function ps_StrToIntDef(value: String; default: Integer): Integer; extdecl; begin result := StrToIntDef(value,default); end; function ps_StrToFloat(value: String): Extended; extdecl; begin result := StrToFloat(value); end; function ps_StrToFloatDef(value: String; default: Extended): Extended; extdecl; begin result := StrToFloatDef(value,default); end; function ps_StrToBool(value: String): Boolean;extdecl; begin result := StrToBool(value); end; function ps_StrToBoolDef(value: String; default: Boolean): Boolean; extdecl; begin result := StrToBoolDef(value,default); end; function ps_Between(s1, s2, str: string): string; extdecl; var I,J : integer; begin; Result := ''; I := pos(s1,str); if I > 0 then begin; i := i + length(s1); j := posex(s2,str,i); if j > 0 then Result := copy(str,i,j-i); end; end; function ps_Implode(Glue : string; Pieces: TStringArray): string;extdecl; begin result := implode(glue,pieces); end; function ps_Explode(del, str: string): TStringArray;extdecl; begin result := Explode(del,str); end; procedure ps_ExplodeWrap(del, str: string; var res : TStringArray);extdecl; begin res := Explode(del,str); end; function ps_Padl(s: String; i: longInt): String;extdecl; begin result := StringOfChar(Char(' '), i - length(s)) + s; end; function ps_Padz(s: String; i: longInt): String;extdecl; begin result := StringOfChar(Char('0'), i - length(s)) + s; end; function ps_Padr(s: String; i: longInt): String;extdecl; begin result := s + StringOfChar(Char(' '), i - Length(s)); end; function ps_ExecRegExpr( const RegExpr, InputStr : String) : boolean;extdecl; begin result := execregexpr(RegExpr,InputStr); end; procedure ps_SplitRegExpr( const RegExpr, InputStr : String; Pieces : TStrings);extdecl; begin SplitRegExpr(RegExpr,InputStr,Pieces); end; function ps_ReplaceRegExpr( const RegExpr, InputStr, ReplaceStr : String; UseSubstitution : boolean) : String;extdecl; begin result := ReplaceRegExpr(RegExpr,InputStr,ReplaceStr,UseSubstitution); end; \ No newline at end of file diff --git a/Units/MMLAddon/PSInc/Wrappers/tpa.inc b/Units/MMLAddon/PSInc/Wrappers/tpa.inc index 8f58014..0c7c547 100644 --- a/Units/MMLAddon/PSInc/Wrappers/tpa.inc +++ b/Units/MMLAddon/PSInc/Wrappers/tpa.inc @@ -28,12 +28,12 @@ begin RAaSTPA(a,dist); end; -function ps_NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;extdecl; +function ps_NearbyPointInArrayEx(const P: TPoint; w, h:Integer;const a: TPointArray): Boolean;extdecl; begin result := NearbyPointInArrayEx(p,w,h,a); end; -function ps_NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean; extdecl; +function ps_NearbyPointInArray(const P: TPoint; Dist:Integer;const a: TPointArray): Boolean; extdecl; begin result := NearbyPointInArray(p,dist,a); end; @@ -73,12 +73,12 @@ begin InvertATPA(a); end; -function ps_MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean; extdecl; +function ps_MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean; extdecl; begin Result := MiddleTPAEx(tpa,x,y); end; -function ps_MiddleTPA(tpa: TPointArray): TPoint; extdecl; +function ps_MiddleTPA(const tpa: TPointArray): TPoint; extdecl; begin result := MiddleTPA(tpa); end; @@ -93,12 +93,12 @@ begin SortATPAFromSize(a,size,closefirst); end; -function ps_InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;extdecl; +function ps_InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;extdecl; begin result := InIntArrayEx(a,where,number); end; -function ps_InIntArray(a: TIntegerArray; Number: Integer): Boolean; extdecl; +function ps_InIntArray(const a: TIntegerArray; Number: Integer): Boolean; extdecl; begin result := InIntArray(a,number); end; @@ -113,42 +113,57 @@ begin ClearSameIntegersAndTPA(a,p); end; -function ps_SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray; extdecl; +function ps_SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray; extdecl; begin result := SplitTPAEx(arr,w,h); end; -function ps_SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray; extdecl; +function ps_SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray; extdecl; begin result := SplitTPA(arr,dist); end; +function ps_FloodFillTPA(const TPA : TPointArray) : T2DPointArray; extdecl; +begin + result := FloodFillTPA(TPA); +end; + procedure ps_FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);extdecl; begin FilterPointsPie(points,sd,ed,minr,maxr,mx,my); end; -function ps_GetATPABounds(ATPA: T2DPointArray): TBox;extdecl; +procedure ps_FilterPointsDist(var Points: TPointArray; const MinDist, MaxDist: Extended; Mx, My: Integer); extdecl; +begin + FilterPointsDist(points,mindist,maxdist,mx,my); +end; + +procedure ps_FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);extdecl; +begin + FilterPointsLine(points,radial,radius,mx,my); +end; + +function ps_GetATPABounds(const ATPA: T2DPointArray): TBox;extdecl; begin result := GetATPABounds(ATPA); end; -function ps_GetTPABounds(TPA: TPointArray): TBox; extdecl; +function ps_GetTPABounds(const TPA: TPointArray): TBox; extdecl; begin result := GetTPABounds(TPA); end; -function ps_FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; extdecl; +function ps_FindTPAinTPA(const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; extdecl; begin Result := FindTPAinTPA(searchTPA,totaltpa,matches); end; -function ps_GetSamePointsATPA( ATPA : T2DPointArray; var Matches : TPointArray) : boolean;extdecl; +function ps_GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean;extdecl; begin result := GetSamePointsATPA(ATPA,Matches); end; -function ps_FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;extdecl; +function ps_FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;extdecl; begin result := FindTextTPAinTPA(height,searchtpa,totaltpa,matches); end; @@ -168,51 +183,66 @@ begin result := RotatePoint(p,angle,mx,my); end; -function ps_FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray; extdecl; +function ps_ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;extdecl; +begin + result := ChangeDistPT(pt,mx,my,newdist); +end; + +function ps_ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean; extdecl; +begin + result := ChangeDistTPA(tpa,mx,my,newdist); +end; + +function ps_FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray; extdecl; begin result := FindGapsTPA(TPA,minpixels); end; -function ps_RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; extdecl; +function ps_RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; extdecl; begin Result := RemoveDistTPointArray(x,y,dist,thepoints,removehigher); end; -function ps_CombineTPA(Ar1, Ar2: TPointArray): TPointArray; extdecl; +function ps_CombineTPA(const Ar1, Ar2: TPointArray): TPointArray; extdecl; begin result := CombineTPA(ar1,ar2); end; -function ps_ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;extdecl; +function ps_ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray;extdecl; begin result := ReArrangeandShortenArrayEx(a,w,h); end; -function ps_ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray; extdecl; +function ps_ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray; extdecl; begin result := ReArrangeandShortenArray(a,dist); end; -function ps_TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray; extdecl; +function ps_TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray; extdecl; begin result := TPAtoATPAEx(tpa,w,h); end; -function ps_TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;extdecl; +function ps_TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray;extdecl; begin Result := TPAtoATPA(tpa,dist); end; -function ps_CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray; extdecl; +function ps_CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray; extdecl; begin result := CombineIntArray(ar1,ar2); end; -function ps_MergeATPA(ATPA : T2DPointArray) : TPointArray; extdecl; +function ps_MergeATPA(const ATPA : T2DPointArray) : TPointArray; extdecl; begin result := MergeATPA(ATPA); end; +procedure ps_AppendTPA(var TPA: TPointArray; const ToAppend: TPointArray); +begin + AppendTPA(tpa,ToAppend); +end; + function ps_TPAFromBox(const Box : TBox) : TPointArray; extdecl; begin result := TPAFromBox(box); @@ -223,12 +253,12 @@ begin Result := RotatePoints(p,a,cx,cy); end; -function ps_FindTPAEdges(p: TPointArray): TPointArray;extdecl; +function ps_FindTPAEdges(const p: TPointArray): TPointArray;extdecl; begin result := FindTPAEdges(p); end; -function ps_ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray; extdecl; +function ps_ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray; extdecl; begin result := ClearTPAFromTPA(arP,ClearPoints); end; @@ -238,7 +268,7 @@ begin result := ReturnPointsNotInTPA(totaltpa,box); end; -function ps_PointInTPA(p: TPoint; arP: TPointArray): Boolean; extdecl; +function ps_PointInTPA(p: TPoint;const arP: TPointArray): Boolean; extdecl; begin result := PointInTPA(p,arp); end; @@ -263,64 +293,64 @@ begin InvertTIA(ti); end; -function ps_SumIntegerArray(Ints : TIntegerArray): Integer; extdecl; +function ps_SumIntegerArray(const Ints : TIntegerArray): Integer; extdecl; begin result := SumIntegerArray(ints); end; -function ps_AverageTIA(tI: TIntegerArray): Integer; extdecl; +function ps_AverageTIA(const tI: TIntegerArray): Integer; extdecl; begin result := AverageTIA(ti); end; -function ps_AverageExtended(tE: TExtendedArray): Extended; extdecl; +function ps_AverageExtended(const tE: TExtendedArray): Extended; extdecl; begin result := AverageExtended(te); end; -procedure ps_SplitTPAExWrap(arr: TPointArray; w, h: Integer; var res : T2DPointArray);extdecl; +procedure ps_SplitTPAExWrap(const arr: TPointArray; w, h: Integer; var res : T2DPointArray);extdecl; begin res := SplitTPAEx(arr,w,h); end; -procedure ps_SplitTPAWrap(arr: TPointArray; Dist: Integer; var res: T2DPointArray);extdecl; +procedure ps_SplitTPAWrap(const arr: TPointArray; Dist: Integer; var res: T2DPointArray);extdecl; begin res := SplitTPA(arr,dist); end; -procedure ps_FindGapsTPAWrap(TPA: TPointArray; MinPixels: Integer; var Res : T2DPointArray); extdecl; +procedure ps_FindGapsTPAWrap(const TPA: TPointArray; MinPixels: Integer; var Res : T2DPointArray); extdecl; begin Res := FindGapsTPA(TPA,MinPixels); end; -procedure ps_RemoveDistTPointArrayWrap(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean; var Res : TPointArray);extdecl; +procedure ps_RemoveDistTPointArrayWrap(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean; var Res : TPointArray);extdecl; begin Res := RemoveDistTPointArray(x,y,dist,thepoints,removehigher); end; -procedure ps_CombineTPAWrap(Ar1, Ar2: TPointArray; var Res : TPointArray);extdecl; +procedure ps_CombineTPAWrap(const Ar1, Ar2: TPointArray; var Res : TPointArray);extdecl; begin Res := CombineTPA(Ar1,Ar2); end; -procedure ps_ReArrangeandShortenArrayExWrap(a: TPointArray; w, h: Integer; var Res : TPointArray);extdecl; +procedure ps_ReArrangeandShortenArrayExWrap(const a: TPointArray; w, h: Integer; var Res : TPointArray);extdecl; begin Res := ReArrangeandShortenArrayEx(a,w,h); end; -procedure ps_ReArrangeandShortenArrayWrap(a: TPointArray; Dist: Integer; var Res : TPointArray);extdecl; +procedure ps_ReArrangeandShortenArrayWrap(const a: TPointArray; Dist: Integer; var Res : TPointArray);extdecl; begin Res := ReArrangeandShortenArray(a,dist); end; -procedure ps_TPAtoATPAExWrap(TPA: TPointArray; w, h: Integer; var Res : T2DPointArray);extdecl; +procedure ps_TPAtoATPAExWrap(const TPA: TPointArray; w, h: Integer; var Res : T2DPointArray);extdecl; begin Res := TPAtoATPAEx(TPA,w,h); end; -procedure ps_TPAtoATPAWrap(TPA: TPointArray; Dist: Integer; var Res : T2DPointArray);extdecl; +procedure ps_TPAtoATPAWrap(const TPA: TPointArray; Dist: Integer; var Res : T2DPointArray);extdecl; begin Res := TPAtoATPA(TPA,Dist); end; -procedure ps_CombineIntArrayWrap(Ar1, Ar2: TIntegerArray; var Res : TIntegerArray);extdecl; +procedure ps_CombineIntArrayWrap(const Ar1, Ar2: TIntegerArray; var Res : TIntegerArray);extdecl; begin Res := CombineIntArray(Ar1,Ar2); end; -procedure ps_MergeATPAWrap(ATPA : T2DPointArray; var Res: TPointArray); extdecl; +procedure ps_MergeATPAWrap(const ATPA : T2DPointArray; var Res: TPointArray); extdecl; begin Res := MergeATPA(ATPA); end; @@ -332,11 +362,11 @@ procedure ps_RotatePointsWrap(Const P: TPointArray; A, cx, cy: Extended; var Res begin Res := RotatePoints(P,a,cx,cy); end; -procedure ps_FindTPAEdgesWrap(p: TPointArray; var Res : TPointArray);extdecl; +procedure ps_FindTPAEdgesWrap(const p: TPointArray; var Res : TPointArray);extdecl; begin Res := FindTPAEdges(p); end; -procedure ps_ClearTPAFromTPAWrap(arP, ClearPoints: TPointArray; var Res : TPointArray);extdecl; +procedure ps_ClearTPAFromTPAWrap(const arP, ClearPoints: TPointArray; var Res : TPointArray);extdecl; begin Res := ClearTPAFromTPA(arP, clearpoints); end; @@ -345,17 +375,35 @@ begin Res := ReturnPointsNotInTPA(TotalTPA,box); end; -procedure ps_FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);extdecl; -begin - FilterPointsLine(points,radial,radius,mx,my); -end; - -function ps_SameTPA(aTPA, bTPA: TPointArray): Boolean;extdecl; +function ps_SameTPA(const aTPA, bTPA: TPointArray): Boolean;extdecl; begin result := SameTPA(atpa,btpa); end; -function ps_TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean;extdecl; +function ps_TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean;extdecl; begin result := TPAInATPA(tpa,inatpa,index); end; +procedure ps_OffsetTPA(var TPA : TPointArray; const Offset : TPoint); extdecl; +begin + OffsetTPA(TPA,offset); +end; + +procedure ps_OffsetATPA(var ATPA : T2DPointArray; const Offset : TPoint);extdecl; +begin + OffsetATPA(atpa,offset); +end; +function ps_CopyTPA(const TPA : TPointArray) : TPointArray;extdecl; +begin + result := Copy(TPA,0,Length(TPA)); +end; + +function ps_CopyATPA(const ATPA : T2DPointArray) : T2DPointArray; extdecl; +var + i,l : integer; +begin + l := high(ATPA); + SetLength(result,l+1); + for i := 0 to l do + result[i] := copy(ATPA[i],0,Length(ATPA[i])); +end; diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc index 074d56d..cdf20ed 100644 --- a/Units/MMLAddon/PSInc/pscompile.inc +++ b/Units/MMLAddon/PSInc/pscompile.inc @@ -26,6 +26,8 @@ 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);'); diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index 2d74711..4aa7a99 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -23,6 +23,7 @@ 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);'); { DTM } @@ -54,7 +55,7 @@ AddFunction(@ps_min,'function Min(a, b: Integer): Integer;'); AddFunction(@ps_minE,'function MinE(a, b: extended): Extended;'); AddFunction(@ps_maxE,'function MaxE(a, b: extended): Extended;'); AddFunction(@ps_iAbs,'function iAbs(a : integer) : integer;'); -AddFunction(@ps_ArcTan2,'function ArcTan2(x,y : extended) : extended;'); +AddFunction(@ps_ArcTan2,'function ArcTan2(y,x : extended) : extended;'); AddFunction(@ps_IntToBox,'function IntToBox(xs,ys,xe,ye : integer) : TBox;'); AddFunction(@ps_IntInBox,'function IntInBox(x, y: Integer; Box: TBox): Boolean;'); AddFunction(@ps_PointToBox,'function PointToBox(PT1,PT2 : TPoint): TBox;'); @@ -73,7 +74,9 @@ AddFunction(@ps_logn,'function logn(base, x : extended): extended;'); AddFunction(@ps_ln,'function ln(x : extended) : extended;'); AddFunction(@ps_inttohex,'function IntToHex(number : integer) : string'); 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;'); {window} SetCurrSection('Window'); AddFunction(@ps_Freeze, 'function Freeze: boolean;'); @@ -108,6 +111,9 @@ AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Inte 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_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);'); AddFunction(@ps_ReadINI,'function ReadINI(const Section, KeyName, FileName: string): string;'); AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName: string);'); @@ -128,6 +134,7 @@ AddFunction(@ps_DecodeTime,'procedure DecodeTime(DateTime : TDateTime; var Hour, 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_DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w, h: integer);'); AddFunction(@ps_DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp: integer);'); @@ -143,6 +150,10 @@ AddFunction(@ps_InputQuery,'function InputQuery(const ACaption, APrompt : String {string} SetCurrSection('String'); AddFunction(@ps_Capitalize,'function Capitalize(str : string) : string;'); +AddFunction(@ps_CompressString,'function CompressString(const Str : string) : string;'); +AddFunction(@ps_DecompressString,'function DecompressString(const Compressed : string) : string;'); +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;'); AddFunction(nil,'function ToStr(x) : string;'); AddFunction(@ps_Between,'function Between(s1, s2, str: string): string;'); @@ -318,8 +329,8 @@ AddFunction(@ps_tpaSwap,'procedure tpaSwap(var a, b: TPointArray);'); AddFunction(@ps_SwapE,'procedure SwapE(var a, b: Extended);'); AddFunction(@ps_RAaSTPAEx,'procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer);'); AddFunction(@ps_RAaSTPA,'procedure RAaSTPA(var a: TPointArray; const Dist: Integer);'); -AddFunction(@ps_NearbyPointInArrayEx,'function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;'); -AddFunction(@ps_NearbyPointInArray,'function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;'); +AddFunction(@ps_NearbyPointInArrayEx,'function NearbyPointInArrayEx(const P: TPoint; w, h:Integer;const a: TPointArray): Boolean;'); +AddFunction(@ps_NearbyPointInArray,'function NearbyPointInArray(const P: TPoint; Dist:Integer;const a: TPointArray): Boolean;'); AddFunction(@ps_QuickTPASort,'procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean);'); AddFunction(@ps_QuickATPASort,'procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean);'); AddFunction(@ps_SortTPAFrom,'procedure SortTPAFrom(var a: TPointArray; const From: TPoint);'); @@ -327,66 +338,75 @@ AddFunction(@ps_SortATPAFrom,'procedure SortATPAFrom(var a: T2DPointArray; const AddFunction(@ps_SortATPAFromFirstPoint,'procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint);'); AddFunction(@ps_InvertTPA,'procedure InvertTPA(var a: TPointArray);'); AddFunction(@ps_InvertATPA,'procedure InvertATPA(var a: T2DPointArray);'); -AddFunction(@ps_MiddleTPAEx,'function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean;'); -AddFunction(@ps_MiddleTPA,'function MiddleTPA(tpa: TPointArray): TPoint;'); +AddFunction(@ps_MiddleTPAEx,'function MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean;'); +AddFunction(@ps_MiddleTPA,'function MiddleTPA(const tpa: TPointArray): TPoint;'); AddFunction(@ps_SortATPASize,'procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean);'); AddFunction(@ps_SortATPAFromSize,'procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean);'); -AddFunction(@ps_InIntArrayEx,'function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;'); -AddFunction(@ps_InIntArray,'function InIntArray(a: TIntegerArray; Number: Integer): Boolean;'); +AddFunction(@ps_InIntArrayEx,'function InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean;'); +AddFunction(@ps_InIntArray,'function InIntArray(const a: TIntegerArray; Number: Integer): Boolean;'); AddFunction(@ps_ClearSameIntegers,'procedure ClearSameIntegers(var a: TIntegerArray);'); AddFunction(@ps_ClearSameIntegersAndTPA,'procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray);'); -AddFunction(@ps_SplitTPAEx,'function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray;'); -AddFunction(@ps_SplitTPA,'function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray;'); +AddFunction(@ps_SplitTPAEx,'function SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray;'); +AddFunction(@ps_SplitTPA,'function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray;'); +AddFunction(@ps_FloodFillTPA,'function FloodFillTPA(const TPA : TPointArray) : T2DPointArray;'); AddFunction(@ps_FilterPointsPie,'procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);'); -AddFunction(@ps_GetATPABounds,'function GetATPABounds(ATPA: T2DPointArray): TBox;'); -AddFunction(@ps_GetTPABounds,'function GetTPABounds(TPA: TPointArray): TBox;'); -AddFunction(@ps_FindTPAinTPA,'function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;'); -AddFunction(@ps_GetSamePointsATPA,'function GetSamePointsATPA( ATPA : T2DPointArray; var Matches : TPointArray) : boolean;'); -AddFunction(@ps_FindTextTPAinTPA,'function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;'); +AddFunction(@ps_FilterPointsLine,'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);'); +AddFunction(@ps_filterpointsdist,'procedure FilterPointsDist(var Points: TPointArray; const MinDist, MaxDist: Extended; Mx, My: Integer);'); +AddFunction(@ps_GetATPABounds,'function GetATPABounds(const ATPA: T2DPointArray): TBox;'); +AddFunction(@ps_GetTPABounds,'function GetTPABounds(const TPA: TPointArray): TBox;'); +AddFunction(@ps_FindTPAinTPA,'function FindTPAinTPA(const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;'); +AddFunction(@ps_GetSamePointsATPA,'function GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean;'); +AddFunction(@ps_FindTextTPAinTPA,'function FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;'); AddFunction(@ps_SortCircleWise,'procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);'); AddFunction(@ps_LinearSort,'procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);'); AddFunction(@ps_RotatePoint,'function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint;'); -AddFunction(@ps_FindGapsTPA,'function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray;'); -AddFunction(@ps_RemoveDistTPointArray,'function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;'); -AddFunction(@ps_CombineTPA,'function CombineTPA(Ar1, Ar2: TPointArray): TPointArray;'); -AddFunction(@ps_ReArrangeandShortenArrayEx,'function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray;'); -AddFunction(@ps_ReArrangeandShortenArray,'function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray;'); -AddFunction(@ps_TPAtoATPAEx,'function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray;'); -AddFunction(@ps_TPAtoATPA,'function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray;'); -AddFunction(@ps_CombineIntArray,'function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray;'); -AddFunction(@ps_MergeATPA,'function MergeATPA(ATPA : T2DPointArray) : TPointArray;'); +AddFunction(@ps_ChangeDistPT,'function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;'); +AddFunction(@ps_ChangeDistTPA,'function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean;'); +AddFunction(@ps_FindGapsTPA,'function FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray;'); +AddFunction(@ps_RemoveDistTPointArray,'function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;'); +AddFunction(@ps_CombineTPA,'function CombineTPA(const Ar1, Ar2: TPointArray): TPointArray;'); +AddFunction(@ps_ReArrangeandShortenArrayEx,'function ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray;'); +AddFunction(@ps_ReArrangeandShortenArray,'function ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray;'); +AddFunction(@ps_TPAtoATPAEx,'function TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray;'); +AddFunction(@ps_TPAtoATPA,'function TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray;'); +AddFunction(@ps_CombineIntArray,'function CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray;'); +AddFunction(@ps_MergeATPA,'function MergeATPA(const ATPA : T2DPointArray) : TPointArray;'); +AddFunction(@ps_AppendTPA,'procedure AppendTPA(var TPA: TPointArray; const ToAppend: TPointArray);'); AddFunction(@ps_TPAFromBox,'function TPAFromBox(const Box : TBox) : TPointArray;'); AddFunction(@ps_RotatePoints,'function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;'); -AddFunction(@ps_FindTPAEdges,'function FindTPAEdges(p: TPointArray): TPointArray;'); -AddFunction(@ps_ClearTPAFromTPA,'function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray;'); +AddFunction(@ps_FindTPAEdges,'function FindTPAEdges(const p: TPointArray): TPointArray;'); +AddFunction(@ps_ClearTPAFromTPA,'function ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray;'); AddFunction(@ps_ReturnPointsNotInTPA,'function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray;'); -AddFunction(@ps_PointInTPA,'function PointInTPA(p: TPoint; arP: TPointArray): Boolean;'); +AddFunction(@ps_PointInTPA,'function PointInTPA(p: TPoint;const arP: TPointArray): Boolean;'); AddFunction(@ps_ClearDoubleTPA,'procedure ClearDoubleTPA(var TPA: TPointArray);'); AddFunction(@ps_TPACountSort,'procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean);'); AddFunction(@ps_TPACountSortBase,'procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean);'); AddFunction(@ps_InvertTIA,'procedure InvertTIA(var tI: TIntegerArray);'); -AddFunction(@ps_SumIntegerArray,'function SumIntegerArray(Ints : TIntegerArray): Integer;'); -AddFunction(@ps_AverageTIA,'function AverageTIA(tI: TIntegerArray): Integer;'); -AddFunction(@ps_AverageExtended,'function AverageExtended(tE: TExtendedArray): Extended;'); -AddFunction(@ps_SplitTPAExWrap,'procedure SplitTPAExWrap(arr: TPointArray; w, h: Integer; var res : T2DPointArray);'); -AddFunction(@ps_SplitTPAWrap,'procedure SplitTPAWrap(arr: TPointArray; Dist: Integer; var res: T2DPointArray);'); -AddFunction(@ps_FindGapsTPAWrap,'procedure FindGapsTPAWrap(TPA: TPointArray; MinPixels: Integer; var Res : T2DPointArray);'); -AddFunction(@ps_RemoveDistTPointArrayWrap,'procedure RemoveDistTPointArrayWrap(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean; var Res : TPointArray);'); -AddFunction(@ps_CombineTPAWrap,'procedure CombineTPAWrap(Ar1, Ar2: TPointArray; var Res : TPointArray);'); -AddFunction(@ps_ReArrangeandShortenArrayExWrap,'procedure ReArrangeandShortenArrayExWrap(a: TPointArray; w, h: Integer; var Res : TPointArray);'); -AddFunction(@ps_ReArrangeandShortenArrayWrap,'procedure ReArrangeandShortenArrayWrap(a: TPointArray; Dist: Integer; var Res : TPointArray);'); -AddFunction(@ps_TPAtoATPAExWrap,'procedure TPAtoATPAExWrap(TPA: TPointArray; w, h: Integer; var Res : T2DPointArray);'); -AddFunction(@ps_TPAtoATPAWrap,'procedure TPAtoATPAWrap(TPA: TPointArray; Dist: Integer; var Res : T2DPointArray);'); -AddFunction(@ps_CombineIntArrayWrap, 'procedure CombineIntArrayWrap(Ar1, Ar2: TIntegerArray; var Res : TIntegerArray);'); +AddFunction(@ps_SumIntegerArray,'function SumIntegerArray(const Ints : TIntegerArray): Integer;'); +AddFunction(@ps_AverageTIA,'function AverageTIA(const tI: TIntegerArray): Integer;'); +AddFunction(@ps_AverageExtended,'function AverageExtended(const tE: TExtendedArray): Extended;'); +AddFunction(@ps_SplitTPAExWrap,'procedure SplitTPAExWrap(const arr: TPointArray; w, h: Integer; var res : T2DPointArray);'); +AddFunction(@ps_SplitTPAWrap,'procedure SplitTPAWrap(const arr: TPointArray; Dist: Integer; var res: T2DPointArray);'); +AddFunction(@ps_FindGapsTPAWrap,'procedure FindGapsTPAWrap(const TPA: TPointArray; MinPixels: Integer; var Res : T2DPointArray);'); +AddFunction(@ps_RemoveDistTPointArrayWrap,'procedure RemoveDistTPointArrayWrap(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean; var Res : TPointArray);'); +AddFunction(@ps_CombineTPAWrap,'procedure CombineTPAWrap(const Ar1, Ar2: TPointArray; var Res : TPointArray);'); +AddFunction(@ps_ReArrangeandShortenArrayExWrap,'procedure ReArrangeandShortenArrayExWrap(const a: TPointArray; w, h: Integer; var Res : TPointArray);'); +AddFunction(@ps_ReArrangeandShortenArrayWrap,'procedure ReArrangeandShortenArrayWrap(const a: TPointArray; Dist: Integer; var Res : TPointArray);'); +AddFunction(@ps_TPAtoATPAExWrap,'procedure TPAtoATPAExWrap(const TPA: TPointArray; w, h: Integer; var Res : T2DPointArray);'); +AddFunction(@ps_TPAtoATPAWrap,'procedure TPAtoATPAWrap(const TPA: TPointArray; Dist: Integer; var Res : T2DPointArray);'); +AddFunction(@ps_CombineIntArrayWrap, 'procedure CombineIntArrayWrap(const Ar1, Ar2: TIntegerArray; var Res : TIntegerArray);'); AddFunction(@ps_ReturnPointsNotInTPAWrap,'procedure ReturnPointsNotInTPAWrap(Const TotalTPA: TPointArray; const Box: TBox; var Res : TPointArray);'); -AddFunction(@ps_MergeATPAWrap,'procedure MergeATPAWrap(ATPA : T2DPointArray; var Res: TPointArray);'); +AddFunction(@ps_MergeATPAWrap,'procedure MergeATPAWrap(const ATPA : T2DPointArray; var Res: TPointArray);'); AddFunction(@ps_TPAFromBoxWrap,'procedure TPAFromBoxWrap(const Box : TBox; var Res : TPointArray);'); AddFunction(@ps_RotatePointsWrap,'procedure RotatePointsWrap(Const P: TPointArray; A, cx, cy: Extended; var Res : TPointArray);'); -AddFunction(@ps_FindTPAEdgesWrap,'procedure FindTPAEdgesWrap(p: TPointArray; var Res : TPointArray);'); -AddFunction(@ps_ClearTPAFromTPAWrap,'procedure ClearTPAFromTPAWrap(arP, ClearPoints: TPointArray; var Res : TPointArray);'); -AddFunction(@ps_FilterPointsLine,'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);'); -AddFunction(@ps_SameTPA,'function SameTPA(aTPA, bTPA: TPointArray): Boolean;'); -AddFunction(@ps_TPAInATPA,'function TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean;'); +AddFunction(@ps_FindTPAEdgesWrap,'procedure FindTPAEdgesWrap(const p: TPointArray; var Res : TPointArray);'); +AddFunction(@ps_ClearTPAFromTPAWrap,'procedure ClearTPAFromTPAWrap(const arP, ClearPoints: TPointArray; var Res : TPointArray);'); +AddFunction(@ps_SameTPA,'function SameTPA(const aTPA, bTPA: TPointArray): Boolean;'); +AddFunction(@ps_TPAInATPA,'function TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean;'); +AddFunction(@ps_offsetTPA,'procedure OffsetTPA(var TPA : TPointArray; const Offset : TPoint);'); +AddFunction(@ps_offsetATPA,'procedure OffsetATPA(var ATPA : T2DPointArray; const Offset : TPoint);'); +AddFunction(@ps_copyTPA,'function CopyTPA(const TPA : TPointArray) : TPointArray;'); +AddFunction(@ps_CopyATPA,'function CopyATPA(const ATPA : T2DPointArray) : T2DPointArray;'); SetCurrSection('Settings'); AddFunction(@ps_KeyIsSetting, 'function KeyIsSetting(const KeyName: String): Boolean;'); diff --git a/Units/MMLAddon/mmisc.pas b/Units/MMLAddon/mmisc.pas index 9de7167..2cf83c8 100644 --- a/Units/MMLAddon/mmisc.pas +++ b/Units/MMLAddon/mmisc.pas @@ -106,7 +106,9 @@ end; function UnTar(const Input: TStream; const outputdir: string; overwrite: boolean): boolean; overload; var Tar : TTarArchive; + Succ : boolean; DirRec : TTarDirRec; + FS : TFileStream; begin; result := false; if not DirectoryExists(outputdir) then @@ -114,23 +116,33 @@ begin; exit; Tar := TTarArchive.Create(input); Tar.reset; + Succ := True; while Tar.FindNext(DirRec) do begin if (DirRec.FileType = ftDirectory) then begin; if not DirectoryExists(outputdir + DirRec.Name) and not CreateDir(outputdir + DirRec.Name) then - exit + begin + Succ := false; + break; + end; end else if (DirRec.FileType = ftNormal) then begin; if FileExists(outputdir + dirrec.name) and not overwrite then continue; - Tar.ReadFile(outputdir + dirrec.name); + try + FS := TFileStream.Create(outputdir +dirrec.name,fmCreate); + tar.ReadFile(fs); + FS.Free; + except + Succ := false; + break; + end; end else mDebugLn(format('Unknown filetype in archive. %s',[dirrec.name])); end; Tar.Free; - Result := true; - + Result := Succ; end; constructor TProcThread.Create; diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 8382318..754d440 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -218,6 +218,7 @@ uses uPSR_extctrls, //Runtime-libs Graphics, //For Graphics types math, //Maths! + mmath, //Real maths! strutils, tpa, //Tpa stuff forms,//Forms @@ -247,6 +248,13 @@ begin mDebugLn(str); end; +procedure ps_DebugLn(str : string); extdecl; +begin + if CurrThread.Prop.WriteTimeStamp then + str := format('[%s]: %s', [TimeToStr(TimeStampToDateTime(MSecsToTimeStamp(GetTickCount - CurrThread.StartTime))), str]); + mDebugLn(str); +end; + function MakeString(data : TPSVariantIFC) : string; begin; if data.Dta = nil then @@ -675,7 +683,7 @@ begin RegisterMethod('procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);'); RegisterMethod('procedure Invert(TargetBitmap : TMufasaBitmap);'); RegisterMethod('procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);'); - RegisterMethod('function Copy: TMufasaBitmap;'); + RegisterMethod('function Copy(const xs,ys,xe,ye : integer) : TMufasaBitmap;'); RegisterMethod('function ToString : string;'); RegisterMethod('function CreateTMask : TMask;'); RegisterMethod('constructor create'); @@ -742,6 +750,12 @@ begin; CurrThread.Client.MBitmaps.FreeBMP(Self.Index); end; +function TMufasaBitmapCopy(Self : TMufasaBitmap;const xs,ys,xe,ye : integer) : TMufasaBitmap; +begin + result := Self.Copy(xs,ys,xe,ye); + CurrThread.Client.MBitmaps.AddBMP(result); +end; + type TRegExp = class(SynRegExpr.TRegExpr); procedure MBmp_Index_r(self : TMufasaBitmap; var Index : integer);begin; Index := self.Index; end; @@ -819,7 +833,7 @@ begin; RegisterMethod(@TMufasaBitmap.Contrast,'CONTRAST'); RegisterMethod(@TMufasaBitmap.Invert,'INVERT'); RegisterMethod(@TMufasaBitmap.Posterize,'POSTERIZE'); - RegisterMethod(@TMufasaBitmap.Copy, 'COPY'); + RegisterMethod(@TMufasaBitmapCopy, 'COPY'); RegisterMethod(@TMufasaBitmap.ToString,'TOSTRING'); RegisterMethod(@TMufasaBitmap.CreateTMask,'CREATETMASK'); RegisterPropertyHelper(@MBmp_TransColorSet_r,nil,'TRANSPARENTCOLORSET'); diff --git a/Units/MMLAddon/stringutil.pas b/Units/MMLAddon/stringutil.pas index ae1d92e..78d986f 100644 --- a/Units/MMLAddon/stringutil.pas +++ b/Units/MMLAddon/stringutil.pas @@ -13,8 +13,14 @@ function ExtractFromStr( Str : string; Extract : StrExtr) : string; function Capitalize(str : string) : string; function Implode(Glue : string; Pieces: TStringArray): string; function Explode(del, str: string): TStringArray; +function CompressString(const Str : string) : string; +function DecompressString(const Compressed : string) : string; +function Base64Encode(const str : string) : string; +function Base64Decode(const str : string) : string; implementation +uses + paszlib, DCPbase64; function Implode(Glue: string;Pieces: TStringArray): string; var @@ -76,6 +82,53 @@ begin; result[lenres-1] := Copy(str,lastpos,lenstr - lastpos + 1); end; +function CompressString(const Str: string): string; +var + Destlen:longword; +begin + result := ''; + Destlen :=BufferLen; + if length(str) < 1 then + exit; + if compress(BufferString,destlen,PChar(Str),length(str)) = Z_OK then + begin + setlength(result,Destlen + 4); + PInteger(@result[1])^ := Length(str); + Move(bufferstring[0],result[5],Destlen); + end; +end; + +function DecompressString(const Compressed: string): string; +var + destlen : Longword; + len,dest : integer; + Compress : PChar; +begin + result := ''; + len := Length(Compressed); + Compress := PChar(Compressed); + if len < 5 then + exit; + dest := PInteger(@compress[0])^; + Inc(Compress,sizeof(integer)); + if dest < 1 then + exit; + destlen := dest; + setlength(result,destlen); + if uncompress(PChar(result),destlen,Compress,len) <> z_OK then + result := ''; +end; + +function Base64Encode(const str: string): string; +begin + result := Base64EncodeStr(str); +end; + +function Base64Decode(const str: string): string; +begin + result := Base64DecodeStr(str); +end; + function Capitalize(str : string) : string; var i , l : integer; diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 52da0b3..ed416fc 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/Units/MMLCore/bitmaps.pas @@ -24,7 +24,7 @@ unit bitmaps; {$mode objfpc}{$H+} - +{$Inline on} interface uses Classes, SysUtils, FPImage,IntfGraphics,graphtype,MufasaTypes,MufasaBase,graphics; @@ -82,8 +82,8 @@ type procedure Invert;overload; procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload; procedure Posterize(Po : integer);overload; - function Copy: TMufasaBitmap;overload; function Copy(const xs,ys,xe,ye : integer) : TMufasaBitmap; overload; + function Copy: TMufasaBitmap;overload; function ToTBitmap: TBitmap; function ToString : string; procedure LoadFromTBitmap(bmp: TBitmap); @@ -173,7 +173,7 @@ begin Bmp1.ValidatePoint(comparebox.x1,comparebox.y1); Bmp1.ValidatePoint(comparebox.x2,comparebox.y2); Bmp2.ValidatePoint(comparebox.x1,comparebox.y1); - Bmp2.ValidatePoint(comparebox.x1,comparebox.y1); + Bmp2.ValidatePoint(comparebox.x2,comparebox.y2); Bmp1.SetAlphaValue(0); Bmp2.SetAlphaValue(0); w1 := bmp1.Width; @@ -542,7 +542,7 @@ var SIndex : Integer; CurrX,CurrY : integer; Search,Replace : LongWord; -procedure AddToStack(x,y : integer); +procedure AddToStack(x,y : integer);inline; begin if LongWord(FData[y * w + x]) = Search then begin @@ -595,7 +595,7 @@ begin Result := TMufasaBitmap.Create; Result.SetSize(xe-xs+1, ye-ys+1); for i := ys to ye do - Move(self.FData[i * self.w + xs], Result.FData[i-ys],result.Width * SizeOf(TRGB32)); + Move(self.FData[i * self.w + xs], Result.FData[(i-ys) * result.w],result.Width * SizeOf(TRGB32)); end; function TMufasaBitmap.ToTBitmap: TBitmap; @@ -625,7 +625,7 @@ begin CorrectData[i].B := FData[i].B; end; DestLen := BufferLen; - if compress(Pchar(BufferString),destlen,PChar(DataStr),w*h*3) = Z_OK then + if compress(BufferString,destlen,PChar(DataStr),w*h*3) = Z_OK then begin; SetLength(DataStr,DestLen); move(bufferstring[0],dataStr[1],DestLen); diff --git a/Units/MMLCore/colour_conv.pas b/Units/MMLCore/colour_conv.pas index dea8709..ef54a80 100644 --- a/Units/MMLCore/colour_conv.pas +++ b/Units/MMLCore/colour_conv.pas @@ -24,6 +24,7 @@ unit colour_conv; {$mode objfpc}{$H+} +{$Inline on} interface diff --git a/Units/MMLCore/files.pas b/Units/MMLCore/files.pas index 21d7224..3596151 100644 --- a/Units/MMLCore/files.pas +++ b/Units/MMLCore/files.pas @@ -82,6 +82,8 @@ begin if FindFirst(Path + '*.' + ext, faAnyFile, SearchRec) = 0 then begin repeat + if (SearchRec.Attr and faDirectory) = faDirectory then + Continue; inc(c); SetLength(Result,c); Result[c-1] := SearchRec.Name; @@ -99,7 +101,7 @@ begin if FindFirst(Path + '*', faDirectory, SearchRec) = 0 then begin repeat - if SearchRec.Name[1] = '.' then + if (SearchRec.Name[1] = '.') or ((SearchRec.Attr and faDirectory) <> faDirectory) then continue; inc(c); SetLength(Result,c); diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index f20cb1e..da8d65a 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -104,6 +104,7 @@ uses // colour_conv,// For RGBToColor, etc. Client, // For the Client Casts. math, //min/max + mmath, tpa, //TPABounds dtmutil ; diff --git a/Units/MMLCore/libloader.pas b/Units/MMLCore/libloader.pas index 1220a5f..a535089 100644 --- a/Units/MMLCore/libloader.pas +++ b/Units/MMLCore/libloader.pas @@ -36,7 +36,7 @@ interface implementation uses - MufasaTypes,MufasaBase,FileUtil; + MufasaTypes,MufasaBase,FileUtil, strutils; procedure TGenericLoader.AddPath(path: string); var @@ -101,6 +101,8 @@ implementation function TGenericLoader.VerifyPath(Path: string): string; begin + if (@path = nil) or (path = '') then + exit(''); Result := Path; if (Result[Length(Result)] <> DS) then begin; diff --git a/Units/MMLCore/mmath.pas b/Units/MMLCore/mmath.pas index 941eea5..a34a2f8 100644 --- a/Units/MMLCore/mmath.pas +++ b/Units/MMLCore/mmath.pas @@ -31,17 +31,20 @@ interface uses Classes, SysUtils,MufasaTypes; -function RotatePoints(P: TPointArray; A, cx, cy: Extended): TPointArray; -function RotatePoint(p: TPoint; angle, mx, my: Extended): TPoint; - +function RotatePoints(const P: TPointArray;const A, cx, cy: Extended): TPointArray; +function RotatePoint(const p: TPoint;const angle, mx, my: Extended): TPoint; +function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint; +function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean; implementation +uses + math; {/\ Rotates the given points (P) by A (in radians) around the point defined by cx, cy. /\} -function RotatePoints(P: TPointArray; A, cx, cy: Extended): TPointArray; +function RotatePoints(const P: TPointArray;const A, cx, cy: Extended): TPointArray; var I, L: Integer; @@ -60,12 +63,43 @@ end; Rotates the given point (p) by A (in radians) around the point defined by cx, cy. /\} -function RotatePoint(p: TPoint; angle, mx, my: Extended): TPoint; +function RotatePoint(const p: TPoint;const angle, mx, my: Extended): TPoint; begin Result.X := Round(mx + cos(angle) * (p.x - mx) - sin(angle) * (p.y - my)); Result.Y := Round(my + sin(angle) * (p.x - mx) + cos(angle) * (p.y- my)); end; +function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint; +var + angle : extended; +begin + angle := ArcTan2(pt.y-my,pt.x-mx); + result.y := round(sin(angle) * newdist) + mx; + result.x := round(cos(angle) * newdist) + my; +end; + +function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean; +var + angle : extended; + i : integer; +begin + result := false; + if length(TPA) < 1 then + exit; + result := true; + try + for i := high(TPA) downto 0 do + begin + angle := ArcTan2(TPA[i].y-my,TPA[i].x-mx); + TPA[i].y := round(sin(angle) * newdist) + mx; + TPA[i].x := round(cos(angle) * newdist) + my; + end; + except + result := false; + end; + +end; + end. diff --git a/Units/MMLCore/ocr.pas b/Units/MMLCore/ocr.pas index a745a0a..5a4b8d1 100644 --- a/Units/MMLCore/ocr.pas +++ b/Units/MMLCore/ocr.pas @@ -41,9 +41,6 @@ type private Client: TObject; FFonts: TMFonts; - {$IFDEF OCRDEBUG} - debugbmp: TMufasaBitmap; - {$ENDIF} function GetFonts:TMFonts; procedure SetFonts(const NewFonts: TMFonts); public @@ -71,6 +68,8 @@ type property Fonts : TMFonts read GetFonts write SetFonts; {$IFDEF OCRDEBUG} procedure DebugToBmp(bmp: TMufasaBitmap; hmod,h: integer); + public + debugbmp: TMufasaBitmap; {$ENDIF} end; @@ -156,16 +155,20 @@ begin {$ENDIF} if FFonts.LoadFont(dirs[i], false) then begin + {$IFDEF FONTDEBUG} fonts_loaded := fonts_loaded + dirs[i] + ', '; + {$ENDIF} result := true; end; end; + {$IFDEF FONTDEBUG} if length(fonts_loaded) > 2 then begin writeln(fonts_loaded); setlength(fonts_loaded,length(fonts_loaded)-2); TClient(Self.Client).WriteLn('Loaded fonts: ' + fonts_loaded); end; + {$ENDIF} If DirectoryExists(path + 'UpChars') then FFonts.LoadFont('UpChars', true); // shadow end; diff --git a/Units/MMLCore/tpa.pas b/Units/MMLCore/tpa.pas index 2f9133f..0ba5876 100644 --- a/Units/MMLCore/tpa.pas +++ b/Units/MMLCore/tpa.pas @@ -29,7 +29,7 @@ interface uses Classes, SysUtils, mufasatypes; -function FastTPASort(TPA: TPointArray; Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray; +function FastTPASort(const TPA: TPointArray;const Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray; procedure QuickSort(var A: TIntegerArray; iLo, iHi: Integer); //Start Wizzyplugin @@ -40,10 +40,10 @@ procedure RAaSTPAEx(var a: TPointArray; const w, h: Integer); procedure RAaSTPA(var a: TPointArray; const Dist: Integer); function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean; function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean; -function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray; -function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray; -function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray; -function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray; +function ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray; +function ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray; +function TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray; +function TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray; procedure QuickTPASort(var A: TIntegerArray; var B: TPointArray; iLo, iHi: Integer; SortUp: Boolean); procedure QuickATPASort(var A: TIntegerArray; var B: T2DPointArray; iLo, iHi: Integer; SortUp: Boolean); procedure SortTPAFrom(var a: TPointArray; const From: TPoint); @@ -51,51 +51,54 @@ procedure SortATPAFrom(var a: T2DPointArray; const From: TPoint); procedure SortATPAFromFirstPoint(var a: T2DPointArray; const From: TPoint); procedure InvertTPA(var a: TPointArray); procedure InvertATPA(var a: T2DPointArray); -function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean; -function MiddleTPA(tpa: TPointArray): TPoint; +function MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean; +function MiddleTPA(const tpa: TPointArray): TPoint; procedure SortATPASize(var a: T2DPointArray; const BigFirst: Boolean); procedure SortATPAFromSize(var a: T2DPointArray; const Size: Integer; CloseFirst: Boolean); -function CombineTPA(Ar1, Ar2: TPointArray): TPointArray; -function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray; -function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean; -function InIntArray(a: TIntegerArray; Number: Integer): Boolean; +function CombineTPA(const Ar1, Ar2: TPointArray): TPointArray; +function CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray; +function InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean; +function InIntArray(const a: TIntegerArray; Number: Integer): Boolean; procedure ClearSameIntegers(var a: TIntegerArray); procedure ClearSameIntegersAndTPA(var a: TIntegerArray; var p: TPointArray); -function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray; -function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray; +function SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray; +function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray; +function FloodFillTPA(const TPA : TPointArray) : T2DPointArray; procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer); +procedure FilterPointsDist(var Points: TPointArray; const MinDist,MaxDist: Extended; Mx, My: Integer); procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer); -function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; -function GetATPABounds(ATPA: T2DPointArray): TBox; -function GetTPABounds(TPA: TPointArray): TBox; -function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; -function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; -function GetSamePointsATPA( ATPA : T2DPointArray; var Matches : TPointArray) : boolean; -function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray; +function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; +function GetATPABounds(const ATPA: T2DPointArray): TBox; +function GetTPABounds(const TPA: TPointArray): TBox; +function FindTPAinTPA(SearchTPA: TPointArray; const TotalTPA: TPointArray; var Matches: TPointArray): Boolean; +function FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; +function GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean; +function FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray; procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean); procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean); -Function MergeATPA(ATPA : T2DPointArray) : TPointArray; +function MergeATPA(const ATPA : T2DPointArray) : TPointArray; +procedure AppendTPA(var TPA : TPointArray; const ToAppend : TPointArray); function TPAFromBox(const Box : TBox) : TPointArray; -Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ; -Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint; inline; -function FindTPAEdges(p: TPointArray): TPointArray; -function PointInTPA(p: TPoint; arP: TPointArray): Boolean; -function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray; +function FindTPAEdges(const p: TPointArray): TPointArray; +function PointInTPA(const p: TPoint;const arP: TPointArray): Boolean; +function ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray; procedure ClearDoubleTPA(var TPA: TPointArray); Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray; Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean); Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean); procedure InvertTIA(var tI: TIntegerArray); -function SumIntegerArray(Ints : TIntegerArray): Integer; -function AverageTIA(tI: TIntegerArray): Integer; -function AverageExtended(tE: TExtendedArray): Extended; -function SameTPA(aTPA, bTPA: TPointArray): Boolean; -function TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean; +function SumIntegerArray(const Ints : TIntegerArray): Integer; +function AverageTIA(const tI: TIntegerArray): Integer; +function AverageExtended(const tE: TExtendedArray): Extended; +function SameTPA(const aTPA, bTPA: TPointArray): Boolean; +function TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean; +procedure OffsetTPA(var TPA : TPointArray; const Offset : TPoint); +procedure OffsetATPA(var ATPA : T2DPointArray; const Offset : TPoint); implementation uses - math; + math,mmath; @@ -104,7 +107,7 @@ uses Very Fast TPA Sort, uses an adepted CountSort algorithm. /\} -Function FastTPASort(TPA: TPointArray; Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray; +Function FastTPASort(const TPA: TPointArray;const Dists: TIntegerArray; maxDist: Integer; CloseFirst: Boolean): TPointArray; { If you want to understand this algorithm, it might be helpful to read about @@ -353,7 +356,7 @@ end; Results the TPointArray a with one point per box with side lengths W and H left. /\} -function ReArrangeandShortenArrayEx(a: TPointArray; w, h: Integer): TPointArray; +function ReArrangeandShortenArrayEx(const a: TPointArray; w, h: Integer): TPointArray; var i, t, c, l: Integer; Found: Boolean; @@ -384,7 +387,7 @@ end; Results the TPointArray a with one point per box with side length Dist left. /\} -function ReArrangeandShortenArray(a: TPointArray; Dist: Integer): TPointArray; +function ReArrangeandShortenArray(const a: TPointArray; Dist: Integer): TPointArray; var i, t, c, l: Integer; Found: Boolean; @@ -415,7 +418,7 @@ end; Splits the TPA to boxes with sidelengths W and H and results them as a T2DPointArray. /\} -function TPAtoATPAEx(TPA: TPointArray; w, h: Integer): T2DPointArray; +function TPAtoATPAEx(const TPA: TPointArray; w, h: Integer): T2DPointArray; var a, b, c, l: LongInt; Found: Boolean; @@ -451,7 +454,7 @@ end; Splits the TPA to boxes with sidelength Dist and results them as a T2DPointArray. /\} -function TPAtoATPA(TPA: TPointArray; Dist: Integer): T2DPointArray; +function TPAtoATPA(const TPA: TPointArray; Dist: Integer): T2DPointArray; var a, b, c, l: LongInt; Found: Boolean; @@ -646,7 +649,7 @@ end; Stores the coordinates of the middle of the TPointArray a to X and Y. /\} -function MiddleTPAEx(TPA: TPointArray; var x, y: Integer): Boolean; +function MiddleTPAEx(const TPA: TPointArray; var x, y: Integer): Boolean; var i, l: Integer; begin @@ -669,7 +672,7 @@ end; Returns the middle of the TPointArray tpa. /\} -function MiddleTPA(tpa: TPointArray): TPoint; +function MiddleTPA(const tpa: TPointArray): TPoint; var i, l: Integer; begin @@ -725,7 +728,7 @@ end; Combines the TPointArrays Ar1 and Ar2, and results the combination. /\} -function CombineTPA(Ar1, Ar2: TPointArray): TPointArray; +function CombineTPA(const Ar1, Ar2: TPointArray): TPointArray; var i, l1, l2: Integer; begin @@ -741,7 +744,7 @@ end; Combines the TIntegerArrays Ar1 and Ar2, and results the combination. /\} -function CombineIntArray(Ar1, Ar2: TIntegerArray): TIntegerArray; +function CombineIntArray(const Ar1, Ar2: TIntegerArray): TIntegerArray; var i, l1, l2: Integer; begin @@ -757,7 +760,7 @@ end; Returns true if the integer Number was found in the integer array a, and stores the index to Where. /\} -function InIntArrayEx(a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean; +function InIntArrayEx(const a: TIntegerArray; var Where: Integer; const Number: Integer): Boolean; var i, l: Integer; begin @@ -776,7 +779,7 @@ end; Returns true if the integer Number was found in the integer array a. /\} -function InIntArray(a: TIntegerArray; Number: Integer): Boolean; +function InIntArray(const a: TIntegerArray; Number: Integer): Boolean; var i, l: Integer; begin @@ -861,7 +864,7 @@ end; Splits the points with max X and Y distances W and H to their own TPointArrays. /\} -function SplitTPAEx(arr: TPointArray; w, h: Integer): T2DPointArray; +function SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray; var t1, t2, c, ec, tc, l: Integer; tpa: TPointArray; @@ -908,7 +911,7 @@ end; Dist 1 puts the points that are next to eachother to their own arrays. /\} -function SplitTPA(arr: TPointArray; Dist: Integer): T2DPointArray; +function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray; var t1, t2, c, ec, tc, l: Integer; tpa: TPointArray; @@ -950,6 +953,105 @@ begin SetLength(Result, c); end; +function FloodFillTPA(const TPA : TPointArray) : T2DPointArray; +var + x,y,i,CurrentArray, LengthTPA,CurrentStack : integer; + TempBox : TBox; + PointsToFill : T2DBoolArray; + Lengths : TIntegerArray; + TempTPA : TPointArray; + Stack : TPointArray; + fx,fy : integer; +begin; + LengthTPA := High(TPA); + if LengthTPA < 1 then + begin; + if LengthTPA = 0 then + begin; + SetLength(Result,1,1); + Result[0][0] := TPA[0]; + end else + SetLength(Result,0); + exit; + end; + TempBox := GetTPABounds(TPA); + SetLength(PointsToFill,TempBox.x2 - TempBox.x1+3,TempBox.y2 - TempBox.y1+3); //W + 2, H + 2 so that we can check the borders + fy := TempBox.y2 - TempBox.y1+3; + fx := TempBox.x2 - TempBox.x1+2; + for i := 0 to fx do + FillChar(PointsToFill[i][0],fy,0); + x := TempBox.x1 - 1; + y := TempBox.y1 - 1; + CurrentArray := -1; + SetLength(Stack , LengthTPA + 1); + SetLength(Lengths , LengthTPA + 1); + SetLength(TempTPA , LengthTPA + 1); + for I := 0 to LengthTPA do + begin; + TempTPA[I].x := TPA[I].x - x; + TempTPA[I].y := TPA[I].y - y; + end; + for I := 0 to LengthTPA do + PointsToFill[TempTPA[I].x][TempTPA[I].y] := True; + for I := 0 to LengthTPA do + if PointsToFill[TempTPA[I].x][TempTPA[I].y] then + begin; + PointsToFill[TempTPA[i].x][TempTPA[i].y] := false; + inc(CurrentArray); + SetLength(Result,CurrentArray + 1); + SetLength(Result[CurrentArray],LengthTPA - I + 1); + Lengths[CurrentArray] := 0; + CurrentStack := 0; + Stack[0].x := TempTPA[I].x; + Stack[0].y := TempTPA[I].y; + While CurrentStack > -1 do + begin; + fx := stack[CurrentStack].x; + fy := stack[CurrentStack].y; + dec(CurrentStack); + Result[CurrentArray][Lengths[CurrentArray]].x := fx + x; + Result[CurrentArray][Lengths[CurrentArray]].y := fy + y; + inc(Lengths[CurrentArray]); + if PointsToFill[fx+1][fy] then + begin + inc(CurrentStack);Stack[CurrentStack].x := fx+1;Stack[Currentstack].y := fy;PointsToFill[fx+1][fy] := false; + end; + if PointsToFill[fx][fy+1] then + begin + inc(CurrentStack);Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy+1;PointsToFill[fx][fy+1] := false; + end; + if PointsToFill[fx-1][fy] then + begin + inc(CurrentStack);Stack[CurrentStack].x := fx-1;Stack[Currentstack].y := fy;PointsToFill[fx-1][fy] := false; + end; + if PointsToFill[fx][fy-1] then + begin + inc(CurrentStack);Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy-1;PointsToFill[fx][fy-1] := false; + end; + if PointsToFill[fx+1][fy+1] then + begin + inc(CurrentStack);Stack[CurrentStack].x := fx+1;Stack[Currentstack].y := fy+1;PointsToFill[fx+1][fy+1] := false; + end; + if PointsToFill[fx-1][fy-1] then + begin + inc(CurrentStack);Stack[CurrentStack].x := fx-1;Stack[Currentstack].y := fy-1;PointsToFill[fx-1][fy-1] := false; + end; + if PointsToFill[fx-1][fy+1] then + begin + inc(CurrentStack);Stack[CurrentStack].x := fx-1;Stack[Currentstack].y := fy+1;PointsToFill[fx-1][fy+1] := false; + end; + if PointsToFill[fx+1][fy-1] then + begin + inc(CurrentStack);Stack[CurrentStack].x := fx+1;Stack[Currentstack].y := fy-1;PointsToFill[fx+1][fy-1] := false; + end; + end; + SetLength(Result[CurrentArray],Lengths[CurrentArray]); + end; + SetLength(Stack,0); + SetLength(TempTPA,0); + SetLength(Lengths,0); +end; + {/\ Removes the points in the TPointArray Points that are not within the degrees \\ SD (StartDegree) and ED (EndDegree) and the distances MinR (MinRadius) and @@ -999,15 +1101,43 @@ begin Points := G; end; +{/\ + Removes the points that don't have a dist between mindist/maxdist with (mx,my) +/\} + +procedure FilterPointsDist(var Points: TPointArray; const MinDist, + MaxDist: Extended; Mx, My: Integer); +var + c,i,l : integer; + d : extended; + mind,maxd : extended; +begin + l := high(points); + c := 0; + mind := sqr(mindist); + maxd := sqr(maxdist); + for i := 0 to l do + begin + d := sqr(Points[i].x - mx) + sqr(points[i].y - my); + if (d >= mind) and (d <= maxd) then + begin + points[c] := points[i]; + inc(c); + end; + end; + setlength(points,c); +end; + {/\ Removes the points in the TPointArray Points that are not on the line defined by angle, radius and center. /\} + procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer); var I, Hi, Ind, y: Integer; P: TPointArray; Box: TBox; - B: Array of Array of Boolean; + B: T2DBoolArray; SinAngle,CosAngle : Extended; begin Ind := 0; @@ -1017,7 +1147,10 @@ begin SetLength(B, max(Box.x2, Round(SinAngle * Radius + MX)) + 1); y:= max(Box.x2, -Round(CosAngle * Radius) + MY); for I:= 0 to High(B) do + begin; SetLength(B[I], y + 1); + FillChar(B[i][0],y+1,0); + end; Hi:= High(Points); for I:= 0 to Hi do B[Points[I].x][Points[I].y]:= True; @@ -1039,7 +1172,7 @@ end; Removes the points that are inside or outside the distance Dist from the point (x, y) from the TPointArray ThePoints. /\} -function RemoveDistTPointArray(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; +function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; var I, L, LL: integer; begin; @@ -1070,7 +1203,7 @@ end; Returns the boundaries of the ATPA as a TBox. /\} -function GetATPABounds(ATPA: T2DPointArray): TBox; +function GetATPABounds(const ATPA: T2DPointArray): TBox; var I,II,L2,L : Integer; begin; @@ -1106,7 +1239,7 @@ end; Returns the boundaries of the TPA as a TBox. /\} -function GetTPABounds(TPA: TPointArray): TBox; +function GetTPABounds(const TPA: TPointArray): TBox; var I,L : Integer; begin; @@ -1135,11 +1268,11 @@ end; \\ to the TPA Matches. Returns true if there were atleast one match(es). /\} -function FindTPAinTPA(SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; +function FindTPAinTPA(SearchTPA : TPointArray; const TotalTPA: TPointArray; var Matches: TPointArray): Boolean; var Len, I,II,LenSearch,xOff,yOff : integer; tx,ty,MatchCount : integer; - Screen : Array of Array of Boolean; + Screen : T2DBoolArray; ScreenBox,SearchBox : TBox; Found: Boolean; begin; @@ -1153,6 +1286,8 @@ begin; SearchBox := GetTPABounds(SearchTPA); try SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1); + for i := ScreenBox.x2 downto 0 do + FillChar(Screen[i][0],screenbox.y2+1,0); except Exit; end; @@ -1212,12 +1347,12 @@ end; Read the description of FindTPAinTPA. Additional Height parameter. /\} -function FindTextTPAinTPA(Height : integer; SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; +function FindTextTPAinTPA(Height : integer;const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean; var Len, I,II,LenSearch,LenTPA,xOff,yOff,x,y: integer; tx,ty,MatchCount : integer; Found : boolean; - Screen : Array of Array of Boolean; + Screen : T2DBoolArray; ScreenBox,SearchBox : TBox; InversedTPA : TPointArray; begin; @@ -1234,7 +1369,9 @@ begin; if height > SearchBox.y2 then Screenbox.y2 := Screenbox.y2 + (height - SearchBox.y2); SearchBox.y2 := Height; - SetLength(Screen, SearchBox.x2 + 1,Searchbox.y2 + 1); + SetLength(Screen, SearchBox.x2 + 1,SearchBox.y2 + 1); + for i := SearchBox.x2 downto 0 do + FillChar(screen[i][0],SearchBox.y2+1,0); SetLength(InversedTPA,(SearchBox.x2 + 1) * (Searchbox.y2 + 1)); for I := 0 to LenSearch do Screen[ SearchTPA[I].x,SearchTPA[I].y] := True; @@ -1262,6 +1399,8 @@ begin; try SetLength(Screen,0); SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1); + for i := ScreenBox.x2 downto 0 do + FillChar(screen[i][0],screenbox.y2+1,0); except Exit; end; @@ -1309,7 +1448,7 @@ end; Finds the points that exist in all TPA's in the ATPA. /\} -function GetSamePointsATPA( ATPA : T2DPointArray; var Matches : TPointArray) : boolean; +function GetSamePointsATPA(const ATPA : T2DPointArray; var Matches : TPointArray) : boolean; var I,ii,Len,MatchesC : integer; MinBox,TempBox : TBox; @@ -1381,10 +1520,10 @@ end; \\ Only horizontal, sorry folks. /\} -function FindGapsTPA(TPA: TPointArray; MinPixels: Integer): T2DPointArray; +function FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray; var Len,TotalLen,LenRes,I,II,III : integer; - Screen : Array of Array of Boolean; + Screen : T2DBoolArray; Height,Width : Integer; Box : TBox; begin; @@ -1397,6 +1536,8 @@ begin; III := 0; try SetLength(Screen,Width + 1,Height + 1); + for i := 0 to Width do + FillChar(Screen[i][0],(Height+1),0); except Exit; end; @@ -1530,7 +1671,7 @@ end; Merges the TPointArrays of the T2DPointArray ATPA in to one TPA. /\} -Function MergeATPA(ATPA: T2DPointArray): TPointArray; +Function MergeATPA(const ATPA: T2DPointArray): TPointArray; var I, II, Len, TempL, CurrentL: integer; begin; @@ -1556,10 +1697,20 @@ begin; end; +procedure AppendTPA(var TPA: TPointArray; const ToAppend: TPointArray); +var + l,lo,i : integer; +begin + l := high(ToAppend); + lo := length(TPA); + setlength(TPA,lo + l + 1); + for i := 0 to l do + TPA[i + lo] := ToAppend[i]; +end; + {/\ Returns a TPointArray of a the full given Box. /\} - function TPAFromBox(const Box : TBox) : TPointArray; var x, y: integer; @@ -1614,9 +1765,9 @@ End; Returns the edges of the given TPA. /\} -function FindTPAEdges(p: TPointArray): TPointArray; +function FindTPAEdges(const p: TPointArray): TPointArray; var - b: array of array of Boolean; + b: T2DBoolArray; i, x, y, l, c: Integer; Box: TBox; begin @@ -1628,7 +1779,10 @@ begin y := (Box.y2 - Box.y1) + 3; SetLength(b, x); for i := 0 to x -1 do + begin SetLength(b[i], y); + FillChar(b[i][0],y,0); + end; for i := 0 to l -1 do b[p[i].x +1 - Box.x1][p[i].y +1 - Box.y1] := True; SetLength(Result, l); @@ -1659,7 +1813,7 @@ end; Notes: In actuallys means IN the array, not in the box shaped by the array. /\} -function PointInTPA(p: TPoint; arP: TPointArray): Boolean; +function PointInTPA(const p: TPoint;const arP: TPointArray): Boolean; var i, l: Integer; begin @@ -1677,11 +1831,12 @@ end; Removes the given ClearPoints from arP. /\} -function ClearTPAFromTPA(arP, ClearPoints: TPointArray): TPointArray; +function ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray; var i, j, l, l2: Integer; Found: Boolean; begin + Setlength(result,0); l := High(arP); l2 := High(ClearPoints); for i := 0 to l do @@ -1734,13 +1889,15 @@ end; Function ReturnPointsNotInTPA(Const TotalTPA: TPointArray; const Box: TBox): TPointArray; var x, y, w, h, i, l: integer; - B: Array of Array of Boolean; + B: T2DBoolArray; begin; w := Box.x2 - Box.x1; h := Box.y2 - Box.y1; if (w = 0) and (h = 0) then Exit; SetLength(b, w + 1, h + 1); + for i := w downto 0 do + FillChar(b[i][0],h+1,0); l := High(TotalTPA); x := 0; for i := 0 to l do @@ -1772,13 +1929,15 @@ end; Procedure TPACountSort(Var TPA: TPointArray;const max: TPoint;Const SortOnX : Boolean); Var - c: Array Of Array Of Integer; + c: T2DIntegerArray; I, II, III, hTPA, cc: Integer; Begin hTPA := High(TPA); if hTPA < 1 then Exit; SetLength(c, max.X + 1,max.Y + 1); + for i := max.x downto 0 do + FillChar(c[i][0],(max.y+1)*sizeof(Integer),0); For I := 0 To hTPA Do c[TPA[I].x][TPA[I].y] := c[TPA[i].x][TPA[i].y] + 1; @@ -1817,7 +1976,7 @@ End; Procedure TPACountSortBase(Var TPA: TPointArray;const maxx, base: TPoint; const SortOnX : Boolean); Var - c: Array Of Array Of Integer; + c: T2DIntegerArray; I, II, III, hTPA, cc: Integer; Max : TPoint; Begin @@ -1827,6 +1986,8 @@ Begin max.X := maxx.X - base.X; max.Y := maxx.Y - base.Y; SetLength(c, max.X + 1,max.Y + 1); + for i := max.x downto 0 do + FillChar(c[i][0],(max.y+1)*sizeof(integer),0); hTPA := High(TPA); For I := 0 To hTPA Do c[TPA[I].x - base.X][TPA[I].y - base.Y] := c[TPA[i].x- base.X][TPA[i].y- base.Y] + 1; @@ -1862,7 +2023,7 @@ End; {/\ Returns the sum of all integers in the array /\} -function SumIntegerArray(Ints : TIntegerArray): Integer; +function SumIntegerArray(const Ints : TIntegerArray): Integer; var I, H: Integer; begin @@ -1890,7 +2051,7 @@ end; Results the Average of an IntegerArray /\} -function AverageTIA(tI: TIntegerArray): Integer; +function AverageTIA(const tI: TIntegerArray): Integer; begin try Result := (SumIntegerArray(tI) div Length(tI)); except Result := 0; end; end; @@ -1898,7 +2059,7 @@ end; {/\ Results the Average of an ExtendedArray /\} -function AverageExtended(tE: TExtendedArray): Extended; +function AverageExtended(const tE: TExtendedArray): Extended; var i, h: Integer; begin @@ -1916,7 +2077,7 @@ end; {/\ Returns true if the two inputed TPA's are exactly the same (so the order matters) /\} -function SameTPA(aTPA, bTPA: TPointArray): Boolean; +function SameTPA(const aTPA, bTPA: TPointArray): Boolean; var I: LongInt; h : integer; @@ -1933,7 +2094,7 @@ end; {/\ Returns true if the TPA is found as one of ATPA's sub-TPA's.. And again, order matters /\} -function TPAInATPA(TPA: TPointArray; InATPA: T2DPointArray; var Index: LongInt): Boolean; +function TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean; var I: LongInt; h : integer; @@ -1949,6 +2110,25 @@ begin Result := False; end; +procedure OffsetTPA(var TPA: TPointArray; const Offset: TPoint); +var + i : integer; +begin + for i := high(TPA) downto 0 do + begin; + inc(TPA[i].x,offset.x); + inc(TPA[i].y,offset.y); + end; +end; + +procedure OffsetATPA(var ATPA: T2DPointArray; const Offset: TPoint); +var + i : integer; +begin + for i := high(ATPA) downto 0 do + OffsetTPA(ATPA[i],Offset); +end; + end. diff --git a/Units/Misc/v_ideCodeInsight.pas b/Units/Misc/v_ideCodeInsight.pas index d65a2b4..be5edb3 100644 --- a/Units/Misc/v_ideCodeInsight.pas +++ b/Units/Misc/v_ideCodeInsight.pas @@ -134,7 +134,7 @@ begin for i := l - 1 downto 0 do begin - if (IncludeBuffer[i].CodeInsight.FileName = FileName) then + if (IncludeBuffer[i].CodeInsight <> nil) and (IncludeBuffer[i].CodeInsight.FileName = FileName) then begin DefineMatch := (IncludeBuffer[i].DefinesIn.Defines = Defines.Defines) and (IncludeBuffer[i].DefinesIn.Stack = Defines.Stack); diff --git a/Units/PascalScript/uPSI_Dialogs.pas b/Units/PascalScript/uPSI_Dialogs.pas index 893f93e..52721f6 100644 --- a/Units/PascalScript/uPSI_Dialogs.pas +++ b/Units/PascalScript/uPSI_Dialogs.pas @@ -27,7 +27,7 @@ type implementation uses - Windows ,Messages ,CommDlg ,Graphics ,Controls ,Forms ,StdCtrls ,Dialogs; + { Windows ,}lcltype,Messages {,CommDlg },Graphics ,Controls ,Forms ,StdCtrls ,Dialogs; (* === compile-time registration functions === *) (*----------------------------------------------------------------------------*) diff --git a/Units/PascalScript/uPSRuntime.pas b/Units/PascalScript/uPSRuntime.pas index 49d96a6..0790bf6 100644 --- a/Units/PascalScript/uPSRuntime.pas +++ b/Units/PascalScript/uPSRuntime.pas @@ -10208,7 +10208,7 @@ begin v := NewPPSVariantIFC(Stack[CurrStack + 1], True); end else v := nil; try - Result := Caller.InnerfuseCall(FSelf, VirtualClassMethodPtrToPtr(p.Ext1, FSelf), cc, MyList, v); + Result := Caller.InnerfuseCall(FSelf, VirtualClassMethodPtrToPtr(p.Ext1, FSelf), TPSCallingConvention(Integer(cc) or 128), MyList, v); finally DisposePPSVariantIFC(v); DisposePPSVariantIFCList(mylist); diff --git a/Units/PascalScript/x86.inc b/Units/PascalScript/x86.inc index df89435..e88053e 100644 --- a/Units/PascalScript/x86.inc +++ b/Units/PascalScript/x86.inc @@ -252,7 +252,7 @@ var CallData: TPSList; pp: ^Byte; {$IFDEF FPC} - IsConstructor: Boolean; + IsConstructor,IsVirtualCons: Boolean; {$ENDIF} EAX, EDX, ECX: Longint; @@ -503,6 +503,18 @@ var Result := True; end; begin + if (Integer(CallingConv) and 128) <> 0 then + begin + {$ifdef FPC} + IsVirtualCons := true; + {$endif} + CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 128); + end else + begin + {$ifdef FPC} + IsVirtualCons:= false + {$endif} + end; if (Integer(CallingConv) and 64) <> 0 then begin {$IFDEF FPC} IsConstructor := true; @@ -573,13 +585,17 @@ begin btchar,btU8, btS8: tbtu8(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil); {$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil); btClass : + begin {$IFDEF FPC} - tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX, - @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil); - {$ELSE} - tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, - @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil); - {$ENDIF} + if IsConstructor or IsVirtualCons then + tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX, + @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil) + else + {$ENDIF} +// {$ELSE} + tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, + @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil); + end; btu32,bts32{$IFDEF FPC},btArray{$ENDIF}: tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil); btPChar: pansichar(res.dta^) := Pansichar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));