From b082c75daa291d72fe67076a6da3efc6bf62e009 Mon Sep 17 00:00:00 2001 From: Raymond Date: Tue, 27 Apr 2010 20:30:51 +0200 Subject: [PATCH 01/13] Hex-conversion functions added. --- Units/MMLAddon/PSInc/Wrappers/math.inc | 10 ++++++++++ Units/MMLAddon/PSInc/psexportedmethods.inc | 2 ++ 2 files changed, 12 insertions(+) diff --git a/Units/MMLAddon/PSInc/Wrappers/math.inc b/Units/MMLAddon/PSInc/Wrappers/math.inc index 486dbce..cdfecb9 100644 --- a/Units/MMLAddon/PSInc/Wrappers/math.inc +++ b/Units/MMLAddon/PSInc/Wrappers/math.inc @@ -163,3 +163,13 @@ function ps_ln(x : extended) : extended;extdecl; begin result := ln(x); end; + +function ps_inttohex(value : integer) : string; +begin + result := IntToHex(value,1); +end; + +function ps_hextoint(hex : string) : integer; +begin + result := StrToInt('$' + hex); +end; diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index 2be7e8b..4263505 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -71,6 +71,8 @@ AddFunction(@ps_FixD,'function FixD(Degrees : extended) : Extended;'); AddFunction(@ps_InRange,'function InRange(const value,min,max : integer) : boolean;'); 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'); {window} SetCurrSection('Window'); From 540dbccfe9680485fbf543847b5e1db1b5411c90 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Thu, 29 Apr 2010 00:45:38 +0200 Subject: [PATCH 02/13] TODO --- Doc/TODO | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 Doc/TODO diff --git a/Doc/TODO b/Doc/TODO new file mode 100644 index 0000000..fb8e7bc --- /dev/null +++ b/Doc/TODO @@ -0,0 +1,3 @@ +mufasa_handbook -> Introduction to simba and all it's features. +mufasa_ps_handbook -> overview of all functions +mufasa_developers -> semi in-depthdoc about mml and simba gui From 325493c8e27ebce08edbca154f0c6008a723e9d4 Mon Sep 17 00:00:00 2001 From: Raymond Date: Thu, 29 Apr 2010 11:33:04 +0200 Subject: [PATCH 03/13] Fixed small bug. --- Units/MMLAddon/scriptproperties.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/Units/MMLAddon/scriptproperties.pas b/Units/MMLAddon/scriptproperties.pas index 9d96508..8f4276e 100644 --- a/Units/MMLAddon/scriptproperties.pas +++ b/Units/MMLAddon/scriptproperties.pas @@ -143,6 +143,7 @@ begin end; SP_OnTerminate : begin + FOnTerminateProcs.Clear; for i := 0 to high(value) do FOnTerminateProcs.Add(Value[i]); FProperties := FProperties + [prop]; From d97c7474d9a889dbdce954389bd121dc8f0c1889 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Thu, 29 Apr 2010 12:51:25 +0200 Subject: [PATCH 04/13] merge --- Doc/mufasa_developers.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Doc/mufasa_developers.tex b/Doc/mufasa_developers.tex index 9084f82..643a48f 100644 --- a/Doc/mufasa_developers.tex +++ b/Doc/mufasa_developers.tex @@ -152,7 +152,7 @@ The structure of a DTM looks like this: Where each point in a DTM has a colour, tolerance, area size and area shape entity. The main point's ``point'' is typically $ (0, 0) $, and all the -sub point points are arelative to the main point. ``Point Match'' defines if a point should match or should \textbf{Not} match. +sub point points are relative to the main point. ``Point Match'' defines if a point should match or should \textbf{Not} match. Of course, the actual representation in Pascal is slightly different: From b84473a3199adbc90e604c4ca7378ddfb92d1b43 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Thu, 29 Apr 2010 12:51:49 +0200 Subject: [PATCH 05/13] Revert "merge" This reverts commit d97c7474d9a889dbdce954389bd121dc8f0c1889. --- Doc/mufasa_developers.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Doc/mufasa_developers.tex b/Doc/mufasa_developers.tex index 643a48f..9084f82 100644 --- a/Doc/mufasa_developers.tex +++ b/Doc/mufasa_developers.tex @@ -152,7 +152,7 @@ The structure of a DTM looks like this: Where each point in a DTM has a colour, tolerance, area size and area shape entity. The main point's ``point'' is typically $ (0, 0) $, and all the -sub point points are relative to the main point. ``Point Match'' defines if a point should match or should \textbf{Not} match. +sub point points are arelative to the main point. ``Point Match'' defines if a point should match or should \textbf{Not} match. Of course, the actual representation in Pascal is slightly different: From cfb407b809d9453b3cf71de639f2e735f764fbc1 Mon Sep 17 00:00:00 2001 From: Raymond Date: Thu, 29 Apr 2010 13:49:48 +0200 Subject: [PATCH 06/13] New Rev-number :). --- Install/windows/Setup.iss | 2 +- Projects/SAMufasaGUI/testunit.pas | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Install/windows/Setup.iss b/Install/windows/Setup.iss index 95552f1..610ba17 100644 --- a/Install/windows/Setup.iss +++ b/Install/windows/Setup.iss @@ -11,7 +11,7 @@ AppVerName=Simba 1.0 Beta AppPublisherURL=http://simba.villavu.com/ AppSupportURL=http://simba.villavu.com/ AppUpdatesURL=http://simba.villavu.com/ -DefaultDirName={pf}\Simba +DefaultDirName={sd}\Simba DefaultGroupName=Simba OutputDir=C:\Remake\Install\windows\ OutputBaseFilename=setup diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 1ab9852..97541d1 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -46,7 +46,7 @@ uses CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; const - SimbaVersion = 637; + SimbaVersion = 640; type From 9f59e8b3fd5d7dfb16b9e8640e332042cbd98d90 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Thu, 29 Apr 2010 19:01:20 +0200 Subject: [PATCH 07/13] Resolve 169 --- Projects/SAMufasaGUI/debugimage.lfm | 6 +- Projects/SAMufasaGUI/testunit.lfm | 110 ++++++++++++++-------------- Projects/SAMufasaGUI/testunit.pas | 11 +++ 3 files changed, 69 insertions(+), 58 deletions(-) diff --git a/Projects/SAMufasaGUI/debugimage.lfm b/Projects/SAMufasaGUI/debugimage.lfm index c3e2b43..cd75727 100644 --- a/Projects/SAMufasaGUI/debugimage.lfm +++ b/Projects/SAMufasaGUI/debugimage.lfm @@ -1,10 +1,10 @@ object DebugImgForm: TDebugImgForm - Left = 491 + Left = 1335 Height = 300 - Top = 266 + Top = 172 Width = 400 BorderIcons = [biSystemMenu, biMinimize] - BorderStyle = bsToolWindow + BorderStyle = bsSingle Caption = 'DebugImgForm' ClientHeight = 300 ClientWidth = 400 diff --git a/Projects/SAMufasaGUI/testunit.lfm b/Projects/SAMufasaGUI/testunit.lfm index 07cc4e8..7145299 100644 --- a/Projects/SAMufasaGUI/testunit.lfm +++ b/Projects/SAMufasaGUI/testunit.lfm @@ -1,18 +1,20 @@ object Form1: TForm1 - Left = 0 - Height = 240 - Top = 0 - Width = 320 + Left = 1594 + Height = 623 + Top = 69 + Width = 660 + ActiveControl = ScriptPanel AllowDropFiles = True Caption = 'THA FUKING SIMBA' - ClientHeight = 220 - ClientWidth = 320 + ClientHeight = 600 + ClientWidth = 660 KeyPreview = True Menu = MainMenu OnClose = FormClose OnCreate = FormCreate OnDestroy = FormDestroy OnDropFiles = FormDropFiles + OnHide = doOnHide OnShortCut = FormShortCuts LCLVersion = '0.9.29' Visible = True @@ -20,7 +22,7 @@ object Form1: TForm1 Left = 0 Height = 24 Top = 0 - Width = 320 + Width = 660 Caption = 'ToolBar1' Images = Mufasa_Image_List ParentShowHint = False @@ -82,40 +84,40 @@ object Form1: TForm1 Action = ActionClearDebug end object TB_PickColour: TToolButton - Left = 1 + Left = 316 Hint = 'Pick a color' - Top = 24 + Top = 2 Caption = 'TB_PickColour' ImageIndex = 0 OnClick = ButtonPickClick end object TB_SelectClient: TToolButton - Left = 24 + Left = 339 Hint = 'Select a client' - Top = 24 + Top = 2 Caption = 'TB_SelectClient' ImageIndex = 2 OnMouseDown = ButtonSelectorDown end object ToolButton8: TToolButton - Left = 47 - Top = 24 + Left = 362 + Top = 2 Width = 4 Caption = 'ToolButton8' Style = tbsDivider end object TB_ReloadPlugins: TToolButton - Left = 51 + Left = 366 Hint = 'Reload plugins' - Top = 24 + Top = 2 Caption = 'TB_ReloadPlugins' Enabled = False ImageIndex = 13 end object TB_Tray: TToolButton - Left = 74 + Left = 389 Hint = 'Minimize to tray' - Top = 24 + Top = 2 Caption = 'TB_Tray' ImageIndex = 17 OnClick = ButtonTrayClick @@ -157,16 +159,16 @@ object Form1: TForm1 Enabled = False end object ToolButton3: TToolButton - Left = 120 - Top = 24 + Left = 435 + Top = 2 Width = 4 Caption = 'ToolButton3' Style = tbsDivider end object TT_Update: TToolButton - Left = 124 + Left = 439 Hint = 'A new update is available' - Top = 24 + Top = 2 Caption = 'TT_Update' ImageIndex = 1 OnClick = TT_UpdateClick @@ -198,17 +200,17 @@ object Form1: TForm1 Style = tbsDivider end object TT_Console: TToolButton - Left = 97 + Left = 412 Hint = 'Hide/Show Console' - Top = 24 + Top = 2 Action = ActionConsole end end object StatusBar: TStatusBar Left = 0 - Height = 22 - Top = 198 - Width = 320 + Height = 17 + Top = 583 + Width = 660 Panels = < item Width = 60 @@ -229,17 +231,17 @@ object Form1: TForm1 object PanelMemo: TPanel Left = 0 Height = 154 - Top = 44 - Width = 320 + Top = 429 + Width = 660 Align = alBottom ClientHeight = 154 - ClientWidth = 320 + ClientWidth = 660 TabOrder = 2 object Memo1: TMemo Left = 1 Height = 152 Top = 1 - Width = 318 + Width = 658 Align = alClient Font.Height = -13 Font.Name = 'Courier New' @@ -252,29 +254,29 @@ object Form1: TForm1 Cursor = crVSplit Left = 0 Height = 5 - Top = 39 - Width = 320 + Top = 424 + Width = 660 Align = alBottom ResizeAnchor = akBottom end object ScriptPanel: TPanel Left = 0 - Height = 15 + Height = 400 Top = 24 - Width = 320 + Width = 660 Align = alClient BevelOuter = bvNone - ClientHeight = 15 - ClientWidth = 320 + ClientHeight = 400 + ClientWidth = 660 DockSite = True TabOrder = 4 OnDockDrop = ScriptPanelDockDrop OnDockOver = ScriptPanelDockOver object PageControl1: TPageControl Left = 155 - Height = 0 + Height = 365 Top = 0 - Width = 165 + Width = 505 Align = alClient Images = Mufasa_Image_List PopupMenu = TabPopup @@ -291,12 +293,12 @@ object Form1: TForm1 object SearchPanel: TPanel Left = 0 Height = 35 - Top = -20 - Width = 320 + Top = 365 + Width = 660 Align = alBottom BevelOuter = bvSpace ClientHeight = 35 - ClientWidth = 320 + ClientWidth = 660 TabOrder = 1 Visible = False object SpeedButtonSearch: TSpeedButton @@ -387,7 +389,7 @@ object Form1: TForm1 end object LabeledEditSearch: TLabeledEdit Left = 104 - Height = 23 + Height = 27 Top = 6 Width = 174 EditLabel.AnchorSideLeft.Control = LabeledEditSearch @@ -395,10 +397,10 @@ object Form1: TForm1 EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = LabeledEditSearch EditLabel.AnchorSideBottom.Control = LabeledEditSearch - EditLabel.Left = 71 - EditLabel.Height = 16 - EditLabel.Top = 9 - EditLabel.Width = 30 + EditLabel.Left = 67 + EditLabel.Height = 18 + EditLabel.Top = 10 + EditLabel.Width = 34 EditLabel.Caption = 'Find: ' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -411,9 +413,9 @@ object Form1: TForm1 end object CheckBoxMatchCase: TCheckBox Left = 320 - Height = 19 + Height = 20 Top = 7 - Width = 80 + Width = 95 Caption = 'Match case' OnClick = CheckBoxMatchCaseClick TabOrder = 1 @@ -421,36 +423,34 @@ object Form1: TForm1 end object SplitterFunctionList: TSplitter Left = 150 - Height = 0 + Height = 365 Top = 0 Width = 5 OnCanResize = SplitterFunctionListCanResize Visible = False end inline frmFunctionList: TFunctionListFrame - Height = 0 + Height = 365 Width = 150 - ClientHeight = 0 + ClientHeight = 365 ClientWidth = 150 OnEndDock = nil TabOrder = 3 inherited FunctionList: TTreeView - Height = 0 - Top = 1 + Height = 316 Width = 150 OnChange = FunctionListChange OnEnter = FunctionListEnter OnExit = FunctionListExit end inherited editSearchList: TEdit - Top = -23 + Top = 338 Width = 150 OnExit = editSearchListExit OnKeyDown = editSearchListKeyDown OnKeyPress = editSearchListKeyPress end inherited FunctionListLabel: TLabel - Top = 0 Width = 146 end end diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 1ab9852..d1f3879 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -248,6 +248,7 @@ type procedure ChangeMouseStatus(Sender: TObject); procedure CheckBoxMatchCaseClick(Sender: TObject); procedure CloseFindPanel; + procedure doOnHide(Sender: TObject); procedure editSearchListExit(Sender: TObject); procedure editSearchListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -1715,6 +1716,16 @@ begin CurrScript.SynEdit.SetFocus; end; +{ + If we are being sent to the background; then minimize other active windows as + well. +} +procedure TForm1.doOnHide(Sender: TObject); +begin + if DebugImgForm.Visible then + DebugImgForm.Hide; +end; + procedure TForm1.StopCodeCompletion; begin CodeCompletionForm.Hide; From 204ae425c00ca026fd6878eb110ae571921378a7 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Thu, 29 Apr 2010 19:21:56 +0200 Subject: [PATCH 08/13] Resolve #154 --- Units/MMLCore/fontloader.pas | 4 ++-- Units/MMLCore/ocr.pas | 16 ++++++++++++++++ 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/Units/MMLCore/fontloader.pas b/Units/MMLCore/fontloader.pas index f5970ba..3eca78d 100644 --- a/Units/MMLCore/fontloader.pas +++ b/Units/MMLCore/fontloader.pas @@ -214,9 +214,9 @@ begin F.Name := F.Name + '_s'; f.Data := InitOCR( LoadGlyphMasks(FPath + Name + DS, Shadow)); Fonts.Add(f); - {$IFDEF FONTDEBUG} + {{$IFDEF FONTDEBUG} TClient(Client).Writeln('Loaded Font ' + f.Name); - {$ENDIF} + {$ENDIF} } end; function TMFonts.LoadSystemFont(const SysFont: TFont; const FontName: string): boolean; diff --git a/Units/MMLCore/ocr.pas b/Units/MMLCore/ocr.pas index b861ca7..a745a0a 100644 --- a/Units/MMLCore/ocr.pas +++ b/Units/MMLCore/ocr.pas @@ -140,6 +140,9 @@ function TMOCR.InitTOCR(const path: string): boolean; var dirs: array of string; i: longint; + {$IFDEF FONTDEBUG} + fonts_loaded: String = ''; + {$ENDIF} begin // We're going to load all fonts now FFonts.Path := path; @@ -147,8 +150,21 @@ begin Result := false; for i := 0 to high(dirs) do begin + {$IFDEF FONTDEBUG} + // REMOVING THIS WILL CAUSE FONTS_LOADED NOT BE ADDED SOMEHOW? + writeln('Loading: ' + dirs[i]); + {$ENDIF} if FFonts.LoadFont(dirs[i], false) then + begin + fonts_loaded := fonts_loaded + dirs[i] + ', '; result := true; + end; + end; + 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; If DirectoryExists(path + 'UpChars') then FFonts.LoadFont('UpChars', true); // shadow From 46262acec68aa19f04b5eeec6c3f8a86106559e0 Mon Sep 17 00:00:00 2001 From: Raymond Date: Fri, 30 Apr 2010 14:37:01 +0200 Subject: [PATCH 09/13] DTMs are now stored as pointers internally. --- Units/MMLCore/dtm.pas | 43 +++++++++++++++++++++-------------- Units/MMLCore/mufasatypes.pas | 3 +++ 2 files changed, 29 insertions(+), 17 deletions(-) diff --git a/Units/MMLCore/dtm.pas b/Units/MMLCore/dtm.pas index 98d0aeb..775cb68 100644 --- a/Units/MMLCore/dtm.pas +++ b/Units/MMLCore/dtm.pas @@ -37,7 +37,7 @@ type TMDTM = class(TObject) private Client: TObject; - DTMList: Array Of pDTM; + DTMList: Array Of PpDTM; FreeSpots: Array Of Integer; procedure CheckIndex(index : integer); public @@ -90,8 +90,8 @@ begin end; if not b then begin; - if DTMList[i].n <> '' then - WriteStr := WriteStr + DTMList[i].n + ', ' + if DTMList[i]^.n <> '' then + WriteStr := WriteStr + DTMList[i]^.n + ', ' else WriteStr := WriteStr + inttostr(i) + ', '; FreeDTM(i); @@ -171,7 +171,7 @@ end; procedure TMDTM.CheckIndex(index: integer); begin - if (index < 0) or (index >= Length(DTMList)) then + if (index < 0) or (index >= Length(DTMList)) or (DTMList[Index] = nil) then raise Exception.CreateFmt('The given DTM Index[%d] doesn''t exist',[index]); end; @@ -185,20 +185,24 @@ end; /\} function TMDTM.AddpDTM(const d: pDTM): Integer; +var + NewDTM : PpDTM; begin + New(NewDTM); + NewDTM^ := d; + if Length(FreeSpots) > 0 then begin - DTMList[FreeSpots[High(FreeSpots)]] := d; Result := FreeSpots[High(FreeSpots)]; SetLength(FreeSpots, High(FreeSpots)); end else begin SetLength(DTMList, Length(DTMList) + 1); - DTMList[High(DTMList)] := d; Result := High(DTMList); end; - NormalizeDTM(DTMList[result]); + DTMList[Result] := NewDTM; + NormalizeDTM(DTMList[result]^); end; {/\ @@ -209,13 +213,13 @@ end; function TMDTM.GetDTM(index: Integer) :pDTM; begin CheckIndex(index); - result := DTMList[index]; + result := DTMList[index]^; end; procedure TMDTM.SetDTMName(DTM: Integer;const s: string); begin CheckIndex(DTM); - DTMList[DTM].n := s; + DTMList[DTM]^.n := s; end; {/\ @@ -227,14 +231,19 @@ end; procedure TMDTM.FreeDTM(DTM: Integer); begin CheckIndex(DTM); - SetLength(DTMList[DTM].p, 0); - SetLength(DTMList[DTM].c, 0); - SetLength(DTMList[DTM].t, 0); - SetLength(DTMList[DTM].asz, 0); - SetLength(DTMList[DTM].ash, 0); - SetLength(DTMList[DTM].bp,0); - DTMList[DTM].l := 0; - DTMList[DTM].n := ''; + with DTMList[DTM]^ do + begin + SetLength(p, 0); + SetLength(c, 0); + SetLength(t, 0); + SetLength(asz, 0); + SetLength(ash, 0); + SetLength(bp,0); + l := 0; + n := ''; + end; + Dispose(DTMList[DTM]); + DTMList[DTM] := nil; SetLength(FreeSpots, Length(FreeSpots) + 1); FreeSpots[High(FreeSpots)] := DTM; end; diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index 079031a..cb208b0 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/Units/MMLCore/mufasatypes.pas @@ -118,6 +118,9 @@ type n: String; // DOEN end; + PpDTM = ^pDTM; + + { Other DTM Types } TDTMPointDef = record From e2712ad9a75e9f3f3390dc1973209ef569c78540 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Fri, 30 Apr 2010 23:25:15 +0200 Subject: [PATCH 10/13] Add LoadFont and FreeFont --- Units/MMLAddon/PSInc/Wrappers/ocr.inc | 12 ++++++++++++ Units/MMLAddon/PSInc/psexportedmethods.inc | 2 ++ 2 files changed, 14 insertions(+) diff --git a/Units/MMLAddon/PSInc/Wrappers/ocr.inc b/Units/MMLAddon/PSInc/Wrappers/ocr.inc index de943bb..c8ce773 100644 --- a/Units/MMLAddon/PSInc/Wrappers/ocr.inc +++ b/Units/MMLAddon/PSInc/Wrappers/ocr.inc @@ -52,3 +52,15 @@ function ps_LoadSystemFont(const SysFont : TFont; const FontName : string) : boo begin result := CurrThread.Client.MOCR.Fonts.LoadSystemFont(SysFont,FontName); end; + +function ps_LoadFont(const FontName: string; shadow: boolean): boolean; extdecl; +begin + result := CurrThread.Client.MOCR.Fonts.LoadFont(FontName, shadow); +end; + +function ps_FreeFont(const FontName: string): boolean; extdecl; +begin + result := CurrThread.Client.MOCR.Fonts.FreeFont(FontName); +end; + + diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index 4263505..ea2c787 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -253,6 +253,8 @@ AddFunction(@ps_getTextAtEx,'function GetTextAtEx(const xs,ys,xe,ye, minvspacing AddFunction(@ps_GetTextAtEx,'function GetTextAtExWrap(const xs,ys,xe,ye, minvspacing, maxvspacing, hspacing,color, tol: integer;const font: string): string;'); AddFunction(@ps_gettextATPA,'function GetTextATPA(const ATPA : T2DPointArray; const maxvspacing : integer; const font : string): string;'); AddFunction(@ps_LoadSystemFont,'function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;'); +AddFunction(@ps_LoadFont, 'function LoadFont(const FontName: string; shadow: boolean): boolean;'); +AddFunction(@ps_FreeFont, 'function FreeFont(const FontName: string): boolean;'); {Bitmaps} SetCurrSection('Bitmaps'); From c0b780fce53e65586f28aa024e946ea6d694c168 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Fri, 30 Apr 2010 23:25:26 +0200 Subject: [PATCH 11/13] Small style fix --- Projects/SAMufasaGUI/testunit.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 39a4c07..88297ff 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -1390,8 +1390,8 @@ begin FormWritelnEx('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now'); Thread.SetPaths(ScriptPath,AppPath,Includepath,PluginPath,fontPath); - if selector.haspicked then Thread.Client.IOManager.SetTarget(Selector.LastPick); - + if selector.haspicked then + Thread.Client.IOManager.SetTarget(Selector.LastPick); loadFontsOnScriptStart := (lowercase(LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True')) = 'true'); // Copy our current fonts From 2baf3670df24b985c7e1739f178d100fd41d7f8e Mon Sep 17 00:00:00 2001 From: Raymond Date: Sat, 1 May 2010 15:00:23 +0200 Subject: [PATCH 12/13] Donno, need to commit somehow. --- Units/MMLAddon/PSInc/Wrappers/bitmap.inc | 17 +++++ Units/MMLAddon/PSInc/psexportedmethods.inc | 2 + Units/MMLCore/bitmaps.pas | 88 +++++++++++++++++++++- 3 files changed, 106 insertions(+), 1 deletion(-) diff --git a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc index 5121fad..6ee58b5 100644 --- a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc +++ b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc @@ -105,6 +105,11 @@ begin; result := CurrThread.Client.MBitmaps[Bmp].FastGetPixels(TPA); end; +function ps_GetBitmapAreaColors(bmp,xs, ys, xe, ye: Integer): T2DIntArray;extdecl; +begin + result := CurrThread.Client.MBitmaps[bmp].GetAreaColors(xs,ys,xe,ye); +end; + procedure ps_FastSetPixel(Bmp,x,y : integer; Color : TColor); extdecl; begin CurrThread.Client.MBitmaps[bmp].FastSetPixel(x,y,color); @@ -299,3 +304,15 @@ procedure ps_FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const begin CurrThread.Client.MBitmaps[bitmap].FloodFill(startPoint,searchcol,replacecol); end; + +function ps_CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer;extdecl; +begin + with CurrThread.Client.MBitmaps do + result := CalculatePixelShift(GetBMP(bmp1),GetBMP(bmp2),comparebox); +end; + +function ps_CalculatePixelTolerance(Bmp1,Bmp2 : Integer; CompareBox : TBox; CTS : integer) : extended;extdecl; +begin + with CurrThread.Client.MBitmaps do + result := CalculatePixelTolerance(GetBMP(bmp1),GetBMP(bmp2),comparebox,cts); +end; diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index 4263505..2145efd 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -304,6 +304,8 @@ AddFunction(@ps_DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap: integer; AT AddFunction(@ps_DrawBitmap,'procedure DrawBitmap(Bmp: Integer; Dest: TCanvas; x, y: Integer);'); AddFunction(@ps_RectangleBitmap,'procedure RectangleBitmap(bitmap : integer; const box : TBox; Color : TColor);'); AddFunction(@ps_FloodfillBitmap,'procedure FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const SearchCol,ReplaceCol : TColor);'); +AddFunction(@ps_CalculatePixelShift,'function CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer;'); +AddFunction(@ps_CalculatePixelTolerance,'function CalculatePixelTolerance(Bmp1,Bmp2 : Integer; CompareBox : TBox; CTS : integer) : extended;'); {tpa} SetCurrSection('TPA'); diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 17c5fc2..52da0b3 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/Units/MMLCore/bitmaps.pas @@ -63,6 +63,7 @@ type function CreateTPA(SearchCol : TColor) : TPointArray; function FastGetPixel(x,y : integer) : TColor; function FastGetPixels(Points : TPointArray) : TIntegerArray; + function GetAreaColors(xs,ys,xe,ye : integer) : T2DIntArray; procedure FastDrawClear(Color : TColor); procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap); procedure FastReplaceColor(OldColor, NewColor: TColor); @@ -91,6 +92,7 @@ type procedure SetTransparentColor(Col : TColor); function GetTransparentColor : TColor; property TransparentColorSet : boolean read FTransparentSet; + procedure SetAlphaValue(const value : byte); constructor Create; destructor Destroy;override; end; @@ -120,7 +122,8 @@ type end; Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage); - + function CalculatePixelShift(Bmp1,Bmp2 : TMufasaBitmap; CompareBox : TBox) : integer; + function CalculatePixelTolerance(Bmp1,Bmp2 : TMufasaBitmap; CompareBox : TBox; CTS : integer) : extended; implementation uses @@ -162,6 +165,68 @@ Begin RawImage.Data := PByte(Ptr); End; +function CalculatePixelShift(Bmp1, Bmp2: TMufasaBitmap; CompareBox: TBox): integer; +var + x,y : integer; + w1,w2 : integer; +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); + Bmp1.SetAlphaValue(0); + Bmp2.SetAlphaValue(0); + w1 := bmp1.Width; + w2 := bmp2.width; + result := 0; + for y := CompareBox.y1 to CompareBox.y2 do + for x := CompareBox.x1 to CompareBox.x2 do + if LongWord(Bmp1.FData[y * w1 + x]) <> LongWord(Bmp2.Fdata[y * w2 + x]) then + inc(result); +end; +//CTS 0 counts the average difference in R,G,B per pixel +//CTS 1 counts the average difference using SQRT(Sqr(r) + sqr(g)+sqr(b)); +function CalculatePixelTolerance(Bmp1, Bmp2: TMufasaBitmap; CompareBox: TBox; + CTS: integer): extended; +var + x,y : integer; + w1,w2 : integer; + Diff : int64; +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); + Bmp1.SetAlphaValue(0); + Bmp2.SetAlphaValue(0); + w1 := bmp1.Width; + w2 := bmp2.width; + result := 0; + if not InRange(CTS,0,1) then + raise exception.CreateFmt('CTS Passed to CalculateTolerance must be in [0..1], it currently is %d',[CTS]); + case CTS of + 0 : begin + Diff := 0; + for y := CompareBox.y1 to CompareBox.y2 do + for x := CompareBox.x1 to CompareBox.x2 do + begin + Diff := Diff + abs(Bmp1.FData[y * w1 + x].r-Bmp2.Fdata[y * w2 + x].r) + + abs(Bmp1.FData[y * w1 + x].g-Bmp2.Fdata[y * w2 + x].g) + + abs(Bmp1.FData[y * w1 + x].b-Bmp2.Fdata[y * w2 + x].b); + end; + Result := Diff / (3 * (CompareBox.x2 - CompareBox.x1 + 1) * (CompareBox.y2-CompareBox.y1 + 1)); //We want the value for the whole Pixel; so divide by 3 (RGB) + end; + 1 : begin + for y := CompareBox.y1 to CompareBox.y2 do + for x := CompareBox.x1 to CompareBox.x2 do + Result := Result + Sqrt(Sqr(Bmp1.FData[y * w1 + x].r-Bmp2.Fdata[y * w2 + x].r) + + Sqr(Bmp1.FData[y * w1 + x].g-Bmp2.Fdata[y * w2 + x].g) + + Sqr(Bmp1.FData[y * w1 + x].b-Bmp2.Fdata[y * w2 + x].b)); + Result := Result / ((CompareBox.x2 - CompareBox.x1 + 1) * (CompareBox.y2-CompareBox.y1 + 1)); //We want the value for the whole Pixel; + end; + end; +end; + function Min(a,b:integer) : integer; begin if a < b then @@ -491,6 +556,7 @@ begin ValidatePoint(StartPT.x,StartPT.y); Search := LongWord(RGBToBGR(SearchCol)); Replace := LongWord(RGBToBGR(ReplaceCol)); + SetAlphaValue(0); if LongWord(FData[StartPT.y * w + StartPT.x]) <> Search then //Only add items to the stack that are the searchcol. Exit; SetLength(Stack,w * h); @@ -781,6 +847,18 @@ begin Result[i] := BGRToRGB(FData[Points[i].y*w + Points[i].x]); end; +function TMufasaBitmap.GetAreaColors(xs, ys, xe, ye : integer): T2DIntArray; +var + x,y : integer; +begin + ValidatePoint(xs,ys); + ValidatePoint(xe,ye); + setlength(result,xe-xs+1,ye-ys+1); + for x := xs to xe do + for y := ys to ye do + result[x-xs][y-ys] := BGRToRGB(FData[y*w+x]); +end; + procedure TMufasaBitmap.SetTransparentColor(Col: TColor); begin self.FTransparentSet:= True; @@ -795,6 +873,14 @@ begin raise Exception.CreateFmt('Transparent color for Bitmap[%d] isn''t set',[index]); end; +procedure TMufasaBitmap.SetAlphaValue(const value: byte); +var + i : integer; +begin + for i := w * h - 1 downto 0 do + FData[i].A:= Value; +end; + procedure TMufasaBitmap.FastDrawClear(Color: TColor); var i : integer; From a8091d58b94ef803dbfa9e0d643d83703c4b2b47 Mon Sep 17 00:00:00 2001 From: Raymond Date: Sun, 2 May 2010 00:44:30 +0200 Subject: [PATCH 13/13] So... SRL Player form now compiles and sort-off runs.. Doesn't work though. Added InputQuery (which is a sort of ReadLn) and did a lot of shit in PS to make it work with SRL playerform. And new version number, now @ 650! Yay. --- Projects/SAMufasaGUI/testunit.lfm | 49 +- Projects/SAMufasaGUI/testunit.pas | 2 +- Units/MMLAddon/PSInc/Wrappers/file.inc | 5 + Units/MMLAddon/PSInc/Wrappers/other.inc | 10 + Units/MMLAddon/PSInc/psexportedmethods.inc | 5 +- Units/MMLAddon/mmlpsthread.pas | 20 +- Units/PascalScript/uPSC_controls.pas | 1 + Units/PascalScript/uPSC_extctrls.pas | 4 + Units/PascalScript/uPSC_stdctrls.pas | 1 + Units/PascalScript/uPSI_ComCtrls.pas | 838 +++++++++++++++++++++ Units/PascalScript/uPSI_Dialogs.pas | 93 +-- Units/PascalScript/uPSR_controls.pas | 7 +- Units/PascalScript/uPSR_extctrls.pas | 19 +- Units/PascalScript/uPSR_stdctrls.pas | 4 +- 14 files changed, 979 insertions(+), 79 deletions(-) create mode 100644 Units/PascalScript/uPSI_ComCtrls.pas diff --git a/Projects/SAMufasaGUI/testunit.lfm b/Projects/SAMufasaGUI/testunit.lfm index 7145299..97a5162 100644 --- a/Projects/SAMufasaGUI/testunit.lfm +++ b/Projects/SAMufasaGUI/testunit.lfm @@ -1,12 +1,11 @@ object Form1: TForm1 - Left = 1594 + Left = 150 Height = 623 Top = 69 Width = 660 - ActiveControl = ScriptPanel AllowDropFiles = True Caption = 'THA FUKING SIMBA' - ClientHeight = 600 + ClientHeight = 603 ClientWidth = 660 KeyPreview = True Menu = MainMenu @@ -208,8 +207,8 @@ object Form1: TForm1 end object StatusBar: TStatusBar Left = 0 - Height = 17 - Top = 583 + Height = 23 + Top = 580 Width = 660 Panels = < item @@ -231,7 +230,7 @@ object Form1: TForm1 object PanelMemo: TPanel Left = 0 Height = 154 - Top = 429 + Top = 426 Width = 660 Align = alBottom ClientHeight = 154 @@ -254,19 +253,19 @@ object Form1: TForm1 Cursor = crVSplit Left = 0 Height = 5 - Top = 424 + Top = 421 Width = 660 Align = alBottom ResizeAnchor = akBottom end object ScriptPanel: TPanel Left = 0 - Height = 400 + Height = 397 Top = 24 Width = 660 Align = alClient BevelOuter = bvNone - ClientHeight = 400 + ClientHeight = 397 ClientWidth = 660 DockSite = True TabOrder = 4 @@ -274,7 +273,7 @@ object Form1: TForm1 OnDockOver = ScriptPanelDockOver object PageControl1: TPageControl Left = 155 - Height = 365 + Height = 362 Top = 0 Width = 505 Align = alClient @@ -293,7 +292,7 @@ object Form1: TForm1 object SearchPanel: TPanel Left = 0 Height = 35 - Top = 365 + Top = 362 Width = 660 Align = alBottom BevelOuter = bvSpace @@ -389,7 +388,7 @@ object Form1: TForm1 end object LabeledEditSearch: TLabeledEdit Left = 104 - Height = 27 + Height = 21 Top = 6 Width = 174 EditLabel.AnchorSideLeft.Control = LabeledEditSearch @@ -397,10 +396,10 @@ object Form1: TForm1 EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = LabeledEditSearch EditLabel.AnchorSideBottom.Control = LabeledEditSearch - EditLabel.Left = 67 - EditLabel.Height = 18 - EditLabel.Top = 10 - EditLabel.Width = 34 + EditLabel.Left = 73 + EditLabel.Height = 14 + EditLabel.Top = 9 + EditLabel.Width = 28 EditLabel.Caption = 'Find: ' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -413,9 +412,9 @@ object Form1: TForm1 end object CheckBoxMatchCase: TCheckBox Left = 320 - Height = 20 + Height = 17 Top = 7 - Width = 95 + Width = 72 Caption = 'Match case' OnClick = CheckBoxMatchCaseClick TabOrder = 1 @@ -423,34 +422,38 @@ object Form1: TForm1 end object SplitterFunctionList: TSplitter Left = 150 - Height = 365 + Height = 362 Top = 0 Width = 5 OnCanResize = SplitterFunctionListCanResize Visible = False end inline frmFunctionList: TFunctionListFrame - Height = 365 + Height = 362 Width = 150 - ClientHeight = 365 + ClientHeight = 362 ClientWidth = 150 OnEndDock = nil TabOrder = 3 inherited FunctionList: TTreeView - Height = 316 + Height = 323 + Top = 18 Width = 150 + DefaultItemHeight = 15 OnChange = FunctionListChange OnEnter = FunctionListEnter OnExit = FunctionListExit end inherited editSearchList: TEdit - Top = 338 + Height = 21 + Top = 341 Width = 150 OnExit = editSearchListExit OnKeyDown = editSearchListKeyDown OnKeyPress = editSearchListKeyPress end inherited FunctionListLabel: TLabel + Height = 14 Width = 146 end end diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 88297ff..3d0ad7d 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -46,7 +46,7 @@ uses CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; const - SimbaVersion = 640; + SimbaVersion = 650; type diff --git a/Units/MMLAddon/PSInc/Wrappers/file.inc b/Units/MMLAddon/PSInc/Wrappers/file.inc index 708dd27..bff5a67 100644 --- a/Units/MMLAddon/PSInc/Wrappers/file.inc +++ b/Units/MMLAddon/PSInc/Wrappers/file.inc @@ -110,3 +110,8 @@ begin; Tempini.DeleteKey(section,keyname); tempini.free; end; + +function ps_ExtractFileExt(const FileName: string): string; extdecl; +begin + result := ExtractFileExt(filename); +end; diff --git a/Units/MMLAddon/PSInc/Wrappers/other.inc b/Units/MMLAddon/PSInc/Wrappers/other.inc index d41afa3..54a82ab 100644 --- a/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/Units/MMLAddon/PSInc/Wrappers/other.inc @@ -163,3 +163,13 @@ function ps_Random(Int: integer): integer; extdecl; begin result := Random(int); end; + +function ps_InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;extdecl; +begin + CurrThread.InputQueryData.ACaption:= ACaption; + CurrThread.InputQueryData.APrompt:= APrompt; + CurrThread.InputQueryData.Value:= Value; + CurrThread.Synchronize(@CurrThread.mInputQuery); + Value := CurrThread.InputQueryData.Value; + result := CurrThread.InputQueryData.Res; +end; diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index c81bdd6..2d74711 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -111,6 +111,7 @@ AddFunction(@ps_FileExists,'function FileExists (const FileName : string ) : Boo 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);'); +AddFunction(@ps_ExtractFileExt,'function ExtractFileExt(const FileName: string): string;'); {other} SetCurrSection('Other'); @@ -137,8 +138,7 @@ AddFunction(@ps_PlaySound,'procedure PlaySound( Sound : string);'); AddFunction(@ps_StopSound,'procedure StopSound;'); AddFunction(@ps_SetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: TVariantArray): boolean;'); AddFunction(@ps_GetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: TVariantArray): boolean;'); - - +AddFunction(@ps_InputQuery,'function InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;'); {string} SetCurrSection('String'); @@ -274,6 +274,7 @@ AddFunction(@ps_FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : AddFunction(@ps_FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);'); AddFunction(@ps_FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;'); AddFunction(@ps_FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;'); +AddFunction(@ps_GetBitmapAreaColors,'function GetBitmapAreaColors(bmp,xs, ys, xe, ye: Integer): T2DIntegerArray;'); AddFunction(@ps_FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor);'); AddFunction(@ps_FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);'); AddFunction(@ps_SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);'); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index ff69a53..8382318 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -72,7 +72,10 @@ type FuncPtr : Pointer; end; TExpMethodArr = array of TExpMethod; - + TInputQueryData = record + ACaption, APrompt,Value : String; + Res : boolean; + end; { TMThread } TMThread = class(TThread) @@ -99,12 +102,14 @@ type StartTime : LongWord; Sett: TMMLSettingsSandbox; + InputQueryData : TInputQueryData;//We need this for InputQuery SyncInfo : PSyncInfo; //We need this for callthreadsafe ErrorData : PErrorData; //We need this for thread-safety etc OnError : TOnError; //Error handeler CompileOnly : boolean; + procedure mInputQuery; procedure HandleError(ErrorRow,ErrorCol,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string); function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean; function LoadFile(ParentFile : string; var filename, contents: string): boolean; @@ -207,8 +212,9 @@ uses stringutil, //String st00f uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, - uPSR_menus, + uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs, files, + dialogs, uPSR_extctrls, //Runtime-libs Graphics, //For Graphics types math, //Maths! @@ -347,6 +353,12 @@ begin self.Client.MFiles.WriteFileEvent := AValue;; end; +procedure TMThread.mInputQuery; +begin + InputQueryData.Res:= InputQuery(InputQueryData.ACaption,InputQueryData.APrompt, + InputQueryData.Value); +end; + procedure TMThread.HandleError(ErrorRow,ErrorCol, ErrorPosition: integer; ErrorStr: string; ErrorType: TErrorType; ErrorModule : string); begin if OnError = nil then @@ -873,6 +885,8 @@ begin SIRegister_Forms(x); SIRegister_ExtCtrls(x); SIRegister_Menus(x); + SIRegister_ComCtrls(x); + SIRegister_Dialogs(x); {$I PSInc/pscompile.inc} SIRegister_Mufasa(x); with x.AddFunction('procedure writeln;').decl do @@ -914,6 +928,8 @@ begin RIRegister_ExtCtrls(x); RIRegister_Menus(x); RIRegister_Mufasa(x); + RIRegister_ComCtrls(x); + RIRegister_Dialogs(x); se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil); se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil); se.RegisterFunctionName('SWAP',@swap_,nil,nil); diff --git a/Units/PascalScript/uPSC_controls.pas b/Units/PascalScript/uPSC_controls.pas index f37d43c..91ec2eb 100644 --- a/Units/PascalScript/uPSC_controls.pas +++ b/Units/PascalScript/uPSC_controls.pas @@ -49,6 +49,7 @@ begin RegisterProperty('ClientHeight', 'Longint', iptRW); RegisterProperty('ClientWidth', 'Longint', iptRW); RegisterProperty('ShowHint', 'Boolean', iptRW); + RegisterProperty('Caption','STRING',iptRW); RegisterProperty('Visible', 'Boolean', iptRW); RegisterProperty('ENABLED', 'BOOLEAN', iptrw); RegisterProperty('CURSOR', 'TCURSOR', iptrw); diff --git a/Units/PascalScript/uPSC_extctrls.pas b/Units/PascalScript/uPSC_extctrls.pas index 16c2102..5ffcde7 100644 --- a/Units/PascalScript/uPSC_extctrls.pas +++ b/Units/PascalScript/uPSC_extctrls.pas @@ -188,15 +188,19 @@ begin with Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TPAGE') do begin RegisterProperty('CAPTION', 'String', iptrw); + RegisterProperty('PageIndex','Integer',iptrw); + RegisterProperty('ONSHOW','TNotifyEvent',iptrw); end; end; procedure SIRegisterTNOTEBOOK(Cl: TPSPascalCompiler); begin with Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TNOTEBOOK') do begin + RegisterMethod('function TabIndexAtClientPos(ClientPos: TPoint): integer;'); RegisterProperty('ACTIVEPAGE', 'String', iptrw); RegisterProperty('COLOR', 'TColor', iptrw); RegisterProperty('FONT', 'TFont', iptrw); + RegisterProperty('PAGECOUNT','INTEGER',iptr); RegisterProperty('PAGEINDEX', 'INTEGER', iptrw); RegisterProperty('PAGES', 'TSTRINGS', iptrw); RegisterProperty('PARENTCOLOR', 'Boolean', iptrw); diff --git a/Units/PascalScript/uPSC_stdctrls.pas b/Units/PascalScript/uPSC_stdctrls.pas index 340de77..ae992fc 100644 --- a/Units/PascalScript/uPSC_stdctrls.pas +++ b/Units/PascalScript/uPSC_stdctrls.pas @@ -476,6 +476,7 @@ begin RegisterProperty('ITEMINDEX', 'INTEGER', iptrw); RegisterProperty('SELCOUNT', 'INTEGER', iptr); RegisterProperty('SELECTED', 'BOOLEAN INTEGER', iptrw); + RegisterProperty('ITEMHEIGHT','INTEGER',iptrw); {$IFNDEF PS_MINIVCL} RegisterMethod('procedure CLEAR'); diff --git a/Units/PascalScript/uPSI_ComCtrls.pas b/Units/PascalScript/uPSI_ComCtrls.pas new file mode 100644 index 0000000..da5a1a2 --- /dev/null +++ b/Units/PascalScript/uPSI_ComCtrls.pas @@ -0,0 +1,838 @@ +unit uPSI_ComCtrls; +{$I PascalScript.inc} +{ +This file has been generated by UnitParser v0.7, written by M. Knight +and updated by NP. v/d Spek and George Birbilis. +Source Code from Carlo Kok has been used to implement various sections of +UnitParser. Components of ROPS are used in the construction of UnitParser, +code implementing the class wrapper is taken from Carlo Kok's conv utility + +} +interface + +uses + SysUtils + ,Classes + ,uPSComponent + ,uPSRuntime + ,uPSCompiler + ; + +{ compile-time registration functions } +procedure SIRegister_TTabControl(CL: TPSPascalCompiler); +procedure SIRegister_TCustomTabControl(CL: TPSPascalCompiler); +procedure SIRegister_TTabControlNoteBookStrings(CL: TPSPascalCompiler); +procedure SIRegister_TTabControlStrings(CL: TPSPascalCompiler); +procedure SIRegister_TPageControl(CL: TPSPascalCompiler); +procedure SIRegister_TTabSheet(CL: TPSPascalCompiler); +procedure SIRegister_TStatusBar(CL: TPSPascalCompiler); +procedure SIRegister_TStatusPanels(CL: TPSPascalCompiler); +procedure SIRegister_TStatusPanel(CL: TPSPascalCompiler); +procedure SIRegister_ComCtrls(CL: TPSPascalCompiler); + +{ run-time registration functions } +procedure RIRegister_ComCtrls_Routines(S: TPSExec); +procedure RIRegister_TTabControl(CL: TPSRuntimeClassImporter); +procedure RIRegister_TCustomTabControl(CL: TPSRuntimeClassImporter); +procedure RIRegister_TTabControlNoteBookStrings(CL: TPSRuntimeClassImporter); +procedure RIRegister_TTabControlStrings(CL: TPSRuntimeClassImporter); +procedure RIRegister_TPageControl(CL: TPSRuntimeClassImporter); +procedure RIRegister_TTabSheet(CL: TPSRuntimeClassImporter); +procedure RIRegister_TStatusBar(CL: TPSRuntimeClassImporter); +procedure RIRegister_TStatusPanels(CL: TPSRuntimeClassImporter); +procedure RIRegister_TStatusPanel(CL: TPSRuntimeClassImporter); +procedure RIRegister_ComCtrls(CL: TPSRuntimeClassImporter); + +implementation + + +uses + LResources + ,LCLIntf + ,LCLType + ,FileUtil + ,LCLProc + ,AvgLvlTree + ,ImgList + ,ActnList + ,GraphType + ,Graphics + ,Menus + ,Controls + ,Forms + ,ExtCtrls + ,Buttons + ,Themes + ,ComCtrls + ,CheckLst + ,StdCtrls + ; + + +(* === compile-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure SIRegister_TTabControl(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomTabControl', 'TTabControl') do + with CL.AddClassN(CL.FindClass('TCustomTabControl'),'TTabControl') do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TCustomTabControl(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomControl', 'TCustomTabControl') do + with CL.AddClassN(CL.FindClass('TCustomControl'),'TCustomTabControl') do + begin + RegisterMethod('Function IndexOfTabAt( X, Y : Integer) : Integer'); + RegisterMethod('Function GetHitTestInfoAt( X, Y : Integer) : THitTests'); + RegisterMethod('Function IndexOfTabWithCaption( const TabCaption : string) : Integer'); + RegisterMethod('Function TabRect( Index : Integer) : TRect'); + RegisterMethod('Function RowCount : Integer'); + RegisterMethod('Procedure ScrollTabs( Delta : Integer)'); + RegisterMethod('Procedure BeginUpdate'); + RegisterMethod('Procedure EndUpdate'); + RegisterMethod('Function IsUpdating : boolean'); + RegisterProperty('TabIndex', 'Integer', iptrw); + RegisterProperty('Tabs', 'TStrings', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TTabControlNoteBookStrings(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TTabControlStrings', 'TTabControlNoteBookStrings') do + with CL.AddClassN(CL.FindClass('TTabControlStrings'),'TTabControlNoteBookStrings') do + begin + RegisterProperty('NoteBook', 'TNoteBook', iptr); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TTabControlStrings(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TStrings', 'TTabControlStrings') do + with CL.AddClassN(CL.FindClass('TStrings'),'TTabControlStrings') do + begin + RegisterMethod('Constructor Create( TheTabControl : TCustomTabControl)'); + RegisterMethod('Function GetHitTestInfoAt( X, Y : Integer) : THitTests'); + RegisterMethod('Function GetSize : integer'); + RegisterMethod('Function IndexOfTabAt( X, Y : Integer) : Integer'); + RegisterMethod('Function RowCount : Integer'); + RegisterMethod('Function TabRect( Index : Integer) : TRect'); + RegisterMethod('Procedure ImageListChange( Sender : TObject)'); + RegisterMethod('Procedure ScrollTabs( Delta : Integer)'); + RegisterMethod('Procedure TabControlBoundsChange'); + RegisterMethod('Procedure UpdateTabImages'); + RegisterMethod('Procedure BeginUpdate'); + RegisterMethod('Procedure EndUpdate'); + RegisterMethod('Function IsUpdating : boolean'); + RegisterProperty('TabControl', 'TCustomTabControl', iptr); + RegisterProperty('TabIndex', 'integer', iptrw); + RegisterProperty('HotTrack', 'Boolean', iptrw); + RegisterProperty('Images', 'TCustomImageList', iptrw); + RegisterProperty('MultiLine', 'Boolean', iptrw); + RegisterProperty('MultiSelect', 'Boolean', iptrw); + RegisterProperty('OwnerDraw', 'Boolean', iptrw); + RegisterProperty('RaggedRight', 'Boolean', iptrw); + RegisterProperty('ScrollOpposite', 'Boolean', iptrw); + RegisterProperty('TabHeight', 'Smallint', iptrw); + RegisterProperty('TabWidth', 'Smallint', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TPageControl(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomNotebook', 'TPageControl') do + with CL.AddClassN(CL.FindClass('TNoteBook'),'TPageControl') do + begin + RegisterMethod('Function FindNextPage( CurPage : TTabSheet; GoForward, CheckTabVisible : Boolean) : TTabSheet'); + RegisterMethod('Procedure SelectNextPage( GoForward : Boolean)'); + RegisterMethod('Procedure SelectNextPage( GoForward : Boolean; CheckTabVisible : Boolean)'); + RegisterProperty('ActivePageIndex', 'Integer', iptrw); + RegisterProperty('Pages', 'TTabSheet Integer', iptr); + RegisterProperty('ActivePage', 'TTabSheet', iptrw); + RegisterProperty('TabIndex', 'Integer', iptrw); + RegisterProperty('OnChange', 'TNotifyEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TTabSheet(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomPage', 'TTabSheet') do + with CL.AddClassN(CL.FindClass('TPage'),'TTabSheet') do + begin + RegisterProperty('PageControl', 'TPageControl', iptrw); + RegisterProperty('TabIndex', 'Integer', iptrw); + RegisterProperty('OnMouseDown','TMouseEvent',iptrw); + RegisterProperty('OnMouseMove','TMouseMoveEvent',iptrw); + RegisterProperty('OnMouseUp','TMouseEvent',iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TStatusBar(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TWinControl', 'TStatusBar') do + with CL.AddClassN(CL.FindClass('TWinControl'),'TStatusBar') do + begin + RegisterMethod('Procedure InvalidatePanel( PanelIndex : integer; PanelParts : TPanelParts)'); + RegisterMethod('Procedure BeginUpdate'); + RegisterMethod('Procedure EndUpdate'); + RegisterMethod('Function GetPanelIndexAt( X, Y : Integer) : Integer'); + RegisterMethod('Function SizeGripEnabled : Boolean'); + RegisterMethod('Function UpdatingStatusBar : boolean'); + RegisterProperty('Canvas', 'TCanvas', iptr); + RegisterProperty('AutoHint', 'Boolean', iptrw); + RegisterProperty('Panels', 'TStatusPanels', iptrw); + RegisterProperty('SimpleText', 'String', iptrw); + RegisterProperty('SimplePanel', 'Boolean', iptrw); + RegisterProperty('SizeGrip', 'Boolean', iptrw); + RegisterProperty('OnDrawPanel', 'TDrawPanelEvent', iptrw); + RegisterProperty('OnHint', 'TNotifyEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TStatusPanels(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCollection', 'TStatusPanels') do + with CL.AddClassN(CL.FindClass('TCollection'),'TStatusPanels') do + begin + RegisterMethod('Constructor Create( AStatusBar : TStatusBar)'); + RegisterMethod('Function Add : TStatusPanel'); + RegisterProperty('Items', 'TStatusPanel Integer', iptrw); + SetDefaultPropery('Items'); + RegisterProperty('StatusBar', 'TStatusBar', iptr); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TStatusPanel(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCollectionItem', 'TStatusPanel') do + with CL.AddClassN(CL.FindClass('TCollectionItem'),'TStatusPanel') do + begin + RegisterMethod('Function StatusBar : TStatusBar'); + RegisterProperty('Alignment', 'TAlignment', iptrw); + RegisterProperty('Bevel', 'TStatusPanelBevel', iptrw); + RegisterProperty('Style', 'TStatusPanelStyle', iptrw); + RegisterProperty('Text', 'string', iptrw); + RegisterProperty('Width', 'Integer', iptrw); + end; +end; +(* === compile-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure SIRegister_TCheckListBox(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomCheckListBox', 'TCheckListBox') do + with CL.AddClassN(CL.FindClass('TCustomCheckListBox'),'TCheckListBox') do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TCustomCheckListBox(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomListBox', 'TCustomCheckListBox') do + with CL.AddClassN(CL.FindClass('TCustomListBox'),'TCustomCheckListBox') do + begin + RegisterMethod('Procedure Toggle( AIndex : Integer)'); + RegisterProperty('AllowGrayed', 'Boolean', iptrw); + RegisterProperty('Checked', 'Boolean Integer', iptrw); + RegisterProperty('ItemEnabled', 'Boolean Integer', iptrw); + RegisterProperty('State', 'TCheckBoxState Integer', iptrw); + RegisterProperty('Count', 'integer', iptr); + RegisterProperty('OnClickCheck', 'TNotifyEvent', iptrw); + RegisterProperty('OnItemClick', 'TCheckListClicked', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_CheckLst(CL: TPSPascalCompiler); +begin + CL.AddTypeS('TCheckListClicked', 'Procedure ( Sender : TObject; Index : integ' + +'er)'); + SIRegister_TCustomCheckListBox(CL); + SIRegister_TCheckListBox(CL); +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_ComCtrls(CL: TPSPascalCompiler); +begin + CL.AddTypeS('THitTest', '( htAbove, htBelow, htNowhere, htOnItem, htOnButton,' + +' htOnIcon, htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htTo' + +'Right )'); + CL.AddTypeS('THitTests', 'set of THitTest'); + CL.AddTypeS('TStatusPanelStyle', '( psText, psOwnerDraw )'); + CL.AddTypeS('TStatusPanelBevel', '( pbNone, pbLowered, pbRaised )'); + CL.AddClassN(CL.FindClass('TOBJECT'),'TStatusBar'); + CL.AddTypeS('TPanelPart', '( ppText, ppBorder, ppWidth )'); + CL.AddTypeS('TPanelParts', 'set of TPanelPart'); + //CL.AddTypeS('TStatusPanelClass', 'class of TStatusPanel'); + SIRegister_TStatusPanel(CL); + SIRegister_TStatusPanels(CL); + CL.AddTypeS('TDrawPanelEvent', 'Procedure ( StatusBar : TStatusBar; Panel : T' + +'StatusPanel; const Rect : TRect)'); + SIRegister_TStatusBar(CL); + CL.AddClassN(CL.FindClass('TOBJECT'),'TPageControl'); + CL.AddTypeS('TTabStyle', '( tsTabs, tsButtons, tsFlatButtons )'); + SIRegister_TTabSheet(CL); + SIRegister_TPageControl(CL); + CL.AddClassN(CL.FindClass('TOBJECT'),'TCustomTabControl'); + SIRegister_TTabControlStrings(CL); + SIRegister_TTabControlNoteBookStrings(CL); + CL.AddTypeS('TDrawTabEvent', 'Procedure ( Control : TCustomTabControl; TabInd' + +'ex : Integer; const Rect : TRect; Active : Boolean)'); + SIRegister_TCustomTabControl(CL); + SIRegister_TTabControl(CL); + SIRegister_CheckLst(CL); +end; + +(* === run-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure TCustomTabControlTabs_W(Self: TCustomTabControl; const T: TStrings); +begin Self.Tabs := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomTabControlTabs_R(Self: TCustomTabControl; var T: TStrings); +begin T := Self.Tabs; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomTabControlTabIndex_W(Self: TCustomTabControl; const T: Integer); +begin Self.TabIndex := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomTabControlTabIndex_R(Self: TCustomTabControl; var T: Integer); +begin T := Self.TabIndex; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlNoteBookStringsNoteBook_R(Self: TTabControlNoteBookStrings; var T: TNoteBook); +begin T := Self.NoteBook; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsTabWidth_W(Self: TTabControlStrings; const T: Smallint); +begin Self.TabWidth := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsTabWidth_R(Self: TTabControlStrings; var T: Smallint); +begin T := Self.TabWidth; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsTabHeight_W(Self: TTabControlStrings; const T: Smallint); +begin Self.TabHeight := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsTabHeight_R(Self: TTabControlStrings; var T: Smallint); +begin T := Self.TabHeight; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsScrollOpposite_W(Self: TTabControlStrings; const T: Boolean); +begin Self.ScrollOpposite := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsScrollOpposite_R(Self: TTabControlStrings; var T: Boolean); +begin T := Self.ScrollOpposite; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsRaggedRight_W(Self: TTabControlStrings; const T: Boolean); +begin Self.RaggedRight := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsRaggedRight_R(Self: TTabControlStrings; var T: Boolean); +begin T := Self.RaggedRight; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsOwnerDraw_W(Self: TTabControlStrings; const T: Boolean); +begin Self.OwnerDraw := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsOwnerDraw_R(Self: TTabControlStrings; var T: Boolean); +begin T := Self.OwnerDraw; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsMultiSelect_W(Self: TTabControlStrings; const T: Boolean); +begin Self.MultiSelect := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsMultiSelect_R(Self: TTabControlStrings; var T: Boolean); +begin T := Self.MultiSelect; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsMultiLine_W(Self: TTabControlStrings; const T: Boolean); +begin Self.MultiLine := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsMultiLine_R(Self: TTabControlStrings; var T: Boolean); +begin T := Self.MultiLine; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsImages_W(Self: TTabControlStrings; const T: TCustomImageList); +begin Self.Images := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsImages_R(Self: TTabControlStrings; var T: TCustomImageList); +begin T := Self.Images; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsHotTrack_W(Self: TTabControlStrings; const T: Boolean); +begin Self.HotTrack := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsHotTrack_R(Self: TTabControlStrings; var T: Boolean); +begin T := Self.HotTrack; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsTabIndex_W(Self: TTabControlStrings; const T: integer); +begin Self.TabIndex := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsTabIndex_R(Self: TTabControlStrings; var T: integer); +begin T := Self.TabIndex; end; + +(*----------------------------------------------------------------------------*) +procedure TTabControlStringsTabControl_R(Self: TTabControlStrings; var T: TCustomTabControl); +begin T := Self.TabControl; end; + +(*----------------------------------------------------------------------------*) +procedure TPageControlOnChange_W(Self: TPageControl; const T: TNotifyEvent); +begin Self.OnChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageControlOnChange_R(Self: TPageControl; var T: TNotifyEvent); +begin T := Self.OnChange; end; + +(*----------------------------------------------------------------------------*) +procedure TPageControlTabIndex_W(Self: TPageControl; const T: Integer); +begin Self.TabIndex := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageControlTabIndex_R(Self: TPageControl; var T: Integer); +begin T := Self.TabIndex; end; + +(*----------------------------------------------------------------------------*) +procedure TPageControlActivePage_W(Self: TPageControl; const T: TTabSheet); +begin Self.ActivePage := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageControlActivePage_R(Self: TPageControl; var T: TTabSheet); +begin T := Self.ActivePage; end; + +(*----------------------------------------------------------------------------*) +procedure TPageControlPages_R(Self: TPageControl; var T: TTabSheet; const t1: Integer); +begin T := Self.Pages[t1]; end; + +(*----------------------------------------------------------------------------*) +procedure TPageControlActivePageIndex_W(Self: TPageControl; const T: Integer); +begin Self.ActivePageIndex := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageControlActivePageIndex_R(Self: TPageControl; var T: Integer); +begin T := Self.ActivePageIndex; end; + +(*----------------------------------------------------------------------------*) +procedure TTabSheetTabIndex_W(Self: TTabSheet; const T: Integer); +begin Self.TabIndex := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabSheetTabIndex_R(Self: TTabSheet; var T: Integer); +begin T := Self.TabIndex; end; + +(*----------------------------------------------------------------------------*) +procedure TTabSheetPageControl_W(Self: TTabSheet; const T: TPageControl); +begin Self.PageControl := T; end; + +(*----------------------------------------------------------------------------*) +procedure TTabSheetPageControl_R(Self: TTabSheet; var T: TPageControl); +begin T := Self.PageControl; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarOnHint_W(Self: TStatusBar; const T: TNotifyEvent); +begin Self.OnHint := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarOnHint_R(Self: TStatusBar; var T: TNotifyEvent); +begin T := Self.OnHint; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarOnDrawPanel_W(Self: TStatusBar; const T: TDrawPanelEvent); +begin Self.OnDrawPanel := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarOnDrawPanel_R(Self: TStatusBar; var T: TDrawPanelEvent); +begin T := Self.OnDrawPanel; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarOnCreatePanelClass_W(Self: TStatusBar; const T: TSBCreatePanelClassEvent); +begin Self.OnCreatePanelClass := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarOnCreatePanelClass_R(Self: TStatusBar; var T: TSBCreatePanelClassEvent); +begin T := Self.OnCreatePanelClass; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarSizeGrip_W(Self: TStatusBar; const T: Boolean); +begin Self.SizeGrip := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarSizeGrip_R(Self: TStatusBar; var T: Boolean); +begin T := Self.SizeGrip; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarSimplePanel_W(Self: TStatusBar; const T: Boolean); +begin Self.SimplePanel := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarSimplePanel_R(Self: TStatusBar; var T: Boolean); +begin T := Self.SimplePanel; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarSimpleText_W(Self: TStatusBar; const T: String); +begin Self.SimpleText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarSimpleText_R(Self: TStatusBar; var T: String); +begin T := Self.SimpleText; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarPanels_W(Self: TStatusBar; const T: TStatusPanels); +begin Self.Panels := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarPanels_R(Self: TStatusBar; var T: TStatusPanels); +begin T := Self.Panels; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarAutoHint_W(Self: TStatusBar; const T: Boolean); +begin Self.AutoHint := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarAutoHint_R(Self: TStatusBar; var T: Boolean); +begin T := Self.AutoHint; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusBarCanvas_R(Self: TStatusBar; var T: TCanvas); +begin T := Self.Canvas; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelsStatusBar_R(Self: TStatusPanels; var T: TStatusBar); +begin T := Self.StatusBar; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelsItems_W(Self: TStatusPanels; const T: TStatusPanel; const t1: Integer); +begin Self.Items[t1] := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelsItems_R(Self: TStatusPanels; var T: TStatusPanel; const t1: Integer); +begin T := Self.Items[t1]; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelWidth_W(Self: TStatusPanel; const T: Integer); +begin Self.Width := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelWidth_R(Self: TStatusPanel; var T: Integer); +begin T := Self.Width; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelText_W(Self: TStatusPanel; const T: string); +begin Self.Text := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelText_R(Self: TStatusPanel; var T: string); +begin T := Self.Text; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelStyle_W(Self: TStatusPanel; const T: TStatusPanelStyle); +begin Self.Style := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelStyle_R(Self: TStatusPanel; var T: TStatusPanelStyle); +begin T := Self.Style; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelBevel_W(Self: TStatusPanel; const T: TStatusPanelBevel); +begin Self.Bevel := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelBevel_R(Self: TStatusPanel; var T: TStatusPanelBevel); +begin T := Self.Bevel; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelAlignment_W(Self: TStatusPanel; const T: TAlignment); +begin Self.Alignment := T; end; + +(*----------------------------------------------------------------------------*) +procedure TStatusPanelAlignment_R(Self: TStatusPanel; var T: TAlignment); +begin T := Self.Alignment; end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_ComCtrls_Routines(S: TPSExec); +begin + S.RegisterDelphiFunction(@CompareExpandedNodes, 'CompareExpandedNodes', cdRegister); + S.RegisterDelphiFunction(@CompareTextWithExpandedNode, 'CompareTextWithExpandedNode', cdRegister); + S.RegisterDelphiFunction(@Register, 'Register', cdRegister); +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TTabControl(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TTabControl) do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TCustomTabControl(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TCustomTabControl) do + begin + RegisterMethod(@TCustomTabControl.IndexOfTabAt, 'IndexOfTabAt'); + RegisterMethod(@TCustomTabControl.GetHitTestInfoAt, 'GetHitTestInfoAt'); + RegisterMethod(@TCustomTabControl.IndexOfTabWithCaption, 'IndexOfTabWithCaption'); + RegisterMethod(@TCustomTabControl.TabRect, 'TabRect'); + RegisterMethod(@TCustomTabControl.RowCount, 'RowCount'); + RegisterMethod(@TCustomTabControl.ScrollTabs, 'ScrollTabs'); + RegisterMethod(@TCustomTabControl.BeginUpdate, 'BeginUpdate'); + RegisterMethod(@TCustomTabControl.EndUpdate, 'EndUpdate'); + RegisterMethod(@TCustomTabControl.IsUpdating, 'IsUpdating'); + RegisterPropertyHelper(@TCustomTabControlTabIndex_R,@TCustomTabControlTabIndex_W,'TabIndex'); + RegisterPropertyHelper(@TCustomTabControlTabs_R,@TCustomTabControlTabs_W,'Tabs'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TTabControlNoteBookStrings(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TTabControlNoteBookStrings) do + begin + RegisterPropertyHelper(@TTabControlNoteBookStringsNoteBook_R,nil,'NoteBook'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TTabControlStrings(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TTabControlStrings) do + begin + RegisterVirtualConstructor(@TTabControlStrings.Create, 'Create'); + RegisterVirtualMethod(@TTabControlStrings.GetHitTestInfoAt, 'GetHitTestInfoAt'); + RegisterVirtualMethod(@TTabControlStrings.IndexOfTabAt, 'IndexOfTabAt'); + RegisterVirtualMethod(@TTabControlStrings.RowCount, 'RowCount'); + RegisterVirtualMethod(@TTabControlStrings.TabRect, 'TabRect'); + RegisterVirtualMethod(@TTabControlStrings.ImageListChange, 'ImageListChange'); + RegisterVirtualMethod(@TTabControlStrings.ScrollTabs, 'ScrollTabs'); + RegisterVirtualMethod(@TTabControlStrings.TabControlBoundsChange, 'TabControlBoundsChange'); + RegisterVirtualMethod(@TTabControlStrings.UpdateTabImages, 'UpdateTabImages'); + RegisterVirtualMethod(@TTabControlStrings.BeginUpdate, 'BeginUpdate'); + RegisterVirtualMethod(@TTabControlStrings.EndUpdate, 'EndUpdate'); + RegisterVirtualMethod(@TTabControlStrings.IsUpdating, 'IsUpdating'); + RegisterPropertyHelper(@TTabControlStringsTabControl_R,nil,'TabControl'); + RegisterPropertyHelper(@TTabControlStringsTabIndex_R,@TTabControlStringsTabIndex_W,'TabIndex'); + RegisterPropertyHelper(@TTabControlStringsHotTrack_R,@TTabControlStringsHotTrack_W,'HotTrack'); + RegisterPropertyHelper(@TTabControlStringsImages_R,@TTabControlStringsImages_W,'Images'); + RegisterPropertyHelper(@TTabControlStringsMultiLine_R,@TTabControlStringsMultiLine_W,'MultiLine'); + RegisterPropertyHelper(@TTabControlStringsMultiSelect_R,@TTabControlStringsMultiSelect_W,'MultiSelect'); + RegisterPropertyHelper(@TTabControlStringsOwnerDraw_R,@TTabControlStringsOwnerDraw_W,'OwnerDraw'); + RegisterPropertyHelper(@TTabControlStringsRaggedRight_R,@TTabControlStringsRaggedRight_W,'RaggedRight'); + RegisterPropertyHelper(@TTabControlStringsScrollOpposite_R,@TTabControlStringsScrollOpposite_W,'ScrollOpposite'); + RegisterPropertyHelper(@TTabControlStringsTabHeight_R,@TTabControlStringsTabHeight_W,'TabHeight'); + RegisterPropertyHelper(@TTabControlStringsTabWidth_R,@TTabControlStringsTabWidth_W,'TabWidth'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TPageControl(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TPageControl) do + begin + RegisterMethod(@TPageControl.FindNextPage, 'FindNextPage'); + RegisterMethod(@TPageControl.SelectNextPage, 'SelectNextPage'); + RegisterMethod(@TPageControl.SelectNextPage, 'SelectNextPage'); + RegisterPropertyHelper(@TPageControlActivePageIndex_R,@TPageControlActivePageIndex_W,'ActivePageIndex'); + RegisterPropertyHelper(@TPageControlPages_R,nil,'Pages'); + RegisterPropertyHelper(@TPageControlActivePage_R,@TPageControlActivePage_W,'ActivePage'); + RegisterPropertyHelper(@TPageControlTabIndex_R,@TPageControlTabIndex_W,'TabIndex'); + RegisterPropertyHelper(@TPageControlOnChange_R,@TPageControlOnChange_W,'OnChange'); + end; +end; +procedure TControlOnMouseDown_W(Self: TTabsheet; T: TMouseEvent); begin Self.OnMouseDown := T; end; +procedure TControlOnMouseDown_R(Self: TTabsheet; var T: TMouseEvent); begin T := Self.OnMouseDown; end; +procedure TControlOnMouseMove_W(Self: TTabsheet; T: TMouseMoveEvent); begin Self.OnMouseMove := T; end; +procedure TControlOnMouseMove_R(Self: TTabsheet; var T: TMouseMoveEvent); begin T := Self.OnMouseMove; end; +procedure TControlOnMouseUp_W(Self: TTabsheet; T: TMouseEvent); begin Self.OnMouseUp := T; end; +procedure TControlOnMouseUp_R(Self: TTabsheet; var T: TMouseEvent); begin T := Self.OnMouseUp; end; +(*----------------------------------------------------------------------------*) +procedure RIRegister_TTabSheet(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TTabSheet) do + begin + RegisterPropertyHelper(@TTabSheetPageControl_R,@TTabSheetPageControl_W,'PageControl'); + RegisterPropertyHelper(@TTabSheetTabIndex_R,@TTabSheetTabIndex_W,'TabIndex'); + RegisterEventPropertyHelper(@TControlOnMouseDown_R,@TControlOnMouseDown_W,'OnMouseDown'); + RegisterEventPropertyHelper(@TControlOnMouseMove_R,@TControlOnMouseMove_W,'OnMouseMove'); + RegisterEventPropertyHelper(@TControlOnMouseUp_R,@TControlOnMouseUp_W,'OnMouseUp'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TStatusBar(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TStatusBar) do + begin + RegisterVirtualMethod(@TStatusBar.InvalidatePanel, 'InvalidatePanel'); + RegisterMethod(@TStatusBar.BeginUpdate, 'BeginUpdate'); + RegisterMethod(@TStatusBar.EndUpdate, 'EndUpdate'); + RegisterMethod(@TStatusBar.GetPanelIndexAt, 'GetPanelIndexAt'); + RegisterMethod(@TStatusBar.SizeGripEnabled, 'SizeGripEnabled'); + RegisterMethod(@TStatusBar.UpdatingStatusBar, 'UpdatingStatusBar'); + RegisterPropertyHelper(@TStatusBarCanvas_R,nil,'Canvas'); + RegisterPropertyHelper(@TStatusBarAutoHint_R,@TStatusBarAutoHint_W,'AutoHint'); + RegisterPropertyHelper(@TStatusBarPanels_R,@TStatusBarPanels_W,'Panels'); + RegisterPropertyHelper(@TStatusBarSimpleText_R,@TStatusBarSimpleText_W,'SimpleText'); + RegisterPropertyHelper(@TStatusBarSimplePanel_R,@TStatusBarSimplePanel_W,'SimplePanel'); + RegisterPropertyHelper(@TStatusBarSizeGrip_R,@TStatusBarSizeGrip_W,'SizeGrip'); + RegisterPropertyHelper(@TStatusBarOnDrawPanel_R,@TStatusBarOnDrawPanel_W,'OnDrawPanel'); + RegisterPropertyHelper(@TStatusBarOnHint_R,@TStatusBarOnHint_W,'OnHint'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TStatusPanels(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TStatusPanels) do + begin + RegisterConstructor(@TStatusPanels.Create, 'Create'); + RegisterMethod(@TStatusPanels.Add, 'Add'); + RegisterPropertyHelper(@TStatusPanelsItems_R,@TStatusPanelsItems_W,'Items'); + RegisterPropertyHelper(@TStatusPanelsStatusBar_R,nil,'StatusBar'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TStatusPanel(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TStatusPanel) do + begin + RegisterMethod(@TStatusPanel.StatusBar, 'StatusBar'); + RegisterPropertyHelper(@TStatusPanelAlignment_R,@TStatusPanelAlignment_W,'Alignment'); + RegisterPropertyHelper(@TStatusPanelBevel_R,@TStatusPanelBevel_W,'Bevel'); + RegisterPropertyHelper(@TStatusPanelStyle_R,@TStatusPanelStyle_W,'Style'); + RegisterPropertyHelper(@TStatusPanelText_R,@TStatusPanelText_W,'Text'); + RegisterPropertyHelper(@TStatusPanelWidth_R,@TStatusPanelWidth_W,'Width'); + end; +end; +(* === run-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxOnItemClick_W(Self: TCustomCheckListBox; const T: TCheckListClicked); +begin Self.OnItemClick := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxOnItemClick_R(Self: TCustomCheckListBox; var T: TCheckListClicked); +begin T := Self.OnItemClick; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxOnClickCheck_W(Self: TCustomCheckListBox; const T: TNotifyEvent); +begin Self.OnClickCheck := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxOnClickCheck_R(Self: TCustomCheckListBox; var T: TNotifyEvent); +begin T := Self.OnClickCheck; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxCount_R(Self: TCustomCheckListBox; var T: integer); +begin T := Self.Count; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxState_W(Self: TCustomCheckListBox; const T: TCheckBoxState; const t1: Integer); +begin Self.State[t1] := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxState_R(Self: TCustomCheckListBox; var T: TCheckBoxState; const t1: Integer); +begin T := Self.State[t1]; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxItemEnabled_W(Self: TCustomCheckListBox; const T: Boolean; const t1: Integer); +begin Self.ItemEnabled[t1] := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxItemEnabled_R(Self: TCustomCheckListBox; var T: Boolean; const t1: Integer); +begin T := Self.ItemEnabled[t1]; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxChecked_W(Self: TCustomCheckListBox; const T: Boolean; const t1: Integer); +begin Self.Checked[t1] := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxChecked_R(Self: TCustomCheckListBox; var T: Boolean; const t1: Integer); +begin T := Self.Checked[t1]; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxAllowGrayed_W(Self: TCustomCheckListBox; const T: Boolean); +begin Self.AllowGrayed := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomCheckListBoxAllowGrayed_R(Self: TCustomCheckListBox; var T: Boolean); +begin T := Self.AllowGrayed; end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_CheckLst_Routines(S: TPSExec); +begin + S.RegisterDelphiFunction(@Register, 'Register', cdRegister); +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TCheckListBox(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TCheckListBox) do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TCustomCheckListBox(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TCustomCheckListBox) do + begin + RegisterMethod(@TCustomCheckListBox.Toggle, 'Toggle'); + RegisterPropertyHelper(@TCustomCheckListBoxAllowGrayed_R,@TCustomCheckListBoxAllowGrayed_W,'AllowGrayed'); + RegisterPropertyHelper(@TCustomCheckListBoxChecked_R,@TCustomCheckListBoxChecked_W,'Checked'); + RegisterPropertyHelper(@TCustomCheckListBoxItemEnabled_R,@TCustomCheckListBoxItemEnabled_W,'ItemEnabled'); + RegisterPropertyHelper(@TCustomCheckListBoxState_R,@TCustomCheckListBoxState_W,'State'); + RegisterPropertyHelper(@TCustomCheckListBoxCount_R,nil,'Count'); + RegisterPropertyHelper(@TCustomCheckListBoxOnClickCheck_R,@TCustomCheckListBoxOnClickCheck_W,'OnClickCheck'); + RegisterPropertyHelper(@TCustomCheckListBoxOnItemClick_R,@TCustomCheckListBoxOnItemClick_W,'OnItemClick'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_CheckLst(CL: TPSRuntimeClassImporter); +begin + RIRegister_TCustomCheckListBox(CL); + RIRegister_TCheckListBox(CL); +end; + + +(*----------------------------------------------------------------------------*) +procedure RIRegister_ComCtrls(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TStatusBar) do + RIRegister_TStatusPanel(CL); + RIRegister_TStatusPanels(CL); + RIRegister_TStatusBar(CL); + with CL.Add(TPageControl) do + RIRegister_TTabSheet(CL); + RIRegister_TPageControl(CL); + with CL.Add(TCustomTabControl) do + RIRegister_TTabControlStrings(CL); + RIRegister_TTabControlNoteBookStrings(CL); + RIRegister_TCustomTabControl(CL); + RIRegister_TTabControl(CL); + RIRegister_CheckLst(CL); +end; + + +end. diff --git a/Units/PascalScript/uPSI_Dialogs.pas b/Units/PascalScript/uPSI_Dialogs.pas index 3fe0b95..893f93e 100644 --- a/Units/PascalScript/uPSI_Dialogs.pas +++ b/Units/PascalScript/uPSI_Dialogs.pas @@ -22,7 +22,8 @@ type procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; procedure ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; end; - + procedure SIRegister_Dialogs(CL: TPSPascalCompiler); + procedure RIRegister_Dialogs(CL: TPSRuntimeClassImporter); implementation uses @@ -58,7 +59,7 @@ end; procedure SIRegister_TPrintDialog(CL: TPSPascalCompiler); begin //with RegClassS(CL,'TCommonDialog', 'TPrintDialog') do - with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrintDialog') do +{ with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrintDialog') do begin RegisterProperty('Collate', 'Boolean', iptrw); RegisterProperty('Copies', 'Integer', iptrw); @@ -69,16 +70,16 @@ begin RegisterProperty('PrintToFile', 'Boolean', iptrw); RegisterProperty('PrintRange', 'TPrintRange', iptrw); RegisterProperty('ToPage', 'Integer', iptrw); - end; + end; } end; (*----------------------------------------------------------------------------*) procedure SIRegister_TPrinterSetupDialog(CL: TPSPascalCompiler); begin //with RegClassS(CL,'TCommonDialog', 'TPrinterSetupDialog') do - with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrinterSetupDialog') do +{ with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrinterSetupDialog') do begin - end; + end;} end; (*----------------------------------------------------------------------------*) @@ -88,11 +89,11 @@ begin with CL.AddClassN(CL.FindClass('TCommonDialog'),'TFontDialog') do begin RegisterProperty('Font', 'TFont', iptrw); - RegisterProperty('Device', 'TFontDialogDevice', iptrw); +// RegisterProperty('Device', 'TFontDialogDevice', iptrw); RegisterProperty('MinFontSize', 'Integer', iptrw); RegisterProperty('MaxFontSize', 'Integer', iptrw); RegisterProperty('Options', 'TFontDialogOptions', iptrw); - RegisterProperty('OnApply', 'TFDApplyEvent', iptrw); +// RegisterProperty('OnApply', 'TFDApplyEvent', iptrw); end; end; @@ -104,7 +105,7 @@ begin begin RegisterProperty('Color', 'TColor', iptrw); RegisterProperty('CustomColors', 'TStrings', iptrw); - RegisterProperty('Options', 'TColorDialogOptions', iptrw); +// RegisterProperty('Options', 'TColorDialogOptions', iptrw); end; end; @@ -127,7 +128,7 @@ begin RegisterProperty('Files', 'TStrings', iptr); RegisterProperty('HistoryList', 'TStrings', iptrw); RegisterProperty('DefaultExt', 'string', iptrw); - RegisterProperty('FileName', 'TFileName', iptrw); + RegisterProperty('FileName', 'String', iptrw); RegisterProperty('Filter', 'string', iptrw); RegisterProperty('FilterIndex', 'Integer', iptrw); RegisterProperty('InitialDir', 'string', iptrw); @@ -137,7 +138,8 @@ begin RegisterProperty('OnFolderChange', 'TNotifyEvent', iptrw); RegisterProperty('OnSelectionChange', 'TNotifyEvent', iptrw); RegisterProperty('OnTypeChange', 'TNotifyEvent', iptrw); - RegisterProperty('OnIncludeItem', 'TIncludeItemEvent', iptrw); + RegisterMethod('function Execute : boolean;'); +// RegisterProperty('OnIncludeItem', 'TIncludeItemEvent', iptrw); end; end; @@ -148,7 +150,7 @@ begin with CL.AddClassN(CL.FindClass('TComponent'),'TCommonDialog') do begin RegisterProperty('Handle', 'HWnd', iptr); - RegisterProperty('Ctl3D', 'Boolean', iptrw); +// RegisterProperty('Ctl3D', 'Boolean', iptrw); RegisterProperty('HelpContext', 'THelpContext', iptrw); RegisterProperty('OnClose', 'TNotifyEvent', iptrw); RegisterProperty('OnShow', 'TNotifyEvent', iptrw); @@ -168,21 +170,21 @@ begin +'ng )'); CL.AddTypeS('TOpenOptions', 'set of TOpenOption'); CL.AddTypeS('TFileEditStyle', '( fsEdit, fsComboBox )'); - CL.AddTypeS('TIncludeItemEvent', 'Procedure ( const OFN : TOFNotifyEx; var In' - +'clude : Boolean)'); +// CL.AddTypeS('TIncludeItemEvent', 'Procedure ( const OFN : TOFNotifyEx; var In' +// +'clude : Boolean)'); SIRegister_TOpenDialog(CL); SIRegister_TSaveDialog(CL); CL.AddTypeS('TColorDialogOption', '( cdFullOpen, cdPreventFullOpen, cdShowHel' +'p, cdSolidColor, cdAnyColor )'); - CL.AddTypeS('TColorDialogOptions', 'set of TColorDialogOption'); +// CL.AddTypeS('TColorDialogOptions', 'set of TColorDialogOption'); SIRegister_TColorDialog(CL); CL.AddTypeS('TFontDialogOption', '( fdAnsiOnly, fdTrueTypeOnly, fdEffects, fd' +'FixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts, fdNoSimulatio' +'ns, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts, fdShowHelp, fdWysiwyg, fdL' +'imitSize, fdScalableOnly, fdApplyButton )'); CL.AddTypeS('TFontDialogOptions', 'set of TFontDialogOption'); - CL.AddTypeS('TFontDialogDevice', '( fdScreen, fdPrinter, fdBoth )'); - CL.AddTypeS('TFDApplyEvent', 'Procedure ( Sender : TObject; Wnd : HWND)'); +// CL.AddTypeS('TFontDialogDevice', '( fdScreen, fdPrinter, fdBoth )'); +// CL.AddTypeS('TFDApplyEvent', 'Procedure ( Sender : TObject; Wnd : HWND)'); SIRegister_TFontDialog(CL); SIRegister_TPrinterSetupDialog(CL); CL.AddTypeS('TPrintRange', '( prAllPages, prSelection, prPageNums )'); @@ -201,17 +203,17 @@ begin CL.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m' +'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )'); CL.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn'); - CL.AddConstantN('mbYesNoCancel','LongInt').Value.ts32 := ord(mbYes) or ord(mbNo) or ord(mbCancel); - CL.AddConstantN('mbOKCancel','LongInt').Value.ts32 := ord(mbOK) or ord(mbCancel); - CL.AddConstantN('mbAbortRetryIgnore','LongInt').Value.ts32 := ord(mbAbort) or ord(mbRetry) or ord(mbIgnore); - CL.AddDelphiFunction('Function CreateMessageDialog( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons) : TForm'); + CL.AddConstantN('mbYesNoCancel','LongInt').SetInt(ord(mbYes) or ord(mbNo) or ord(mbCancel)); + CL.AddConstantN('mbOKCancel','LongInt').SetInt(ord(mbOK) or ord(mbCancel)); + CL.AddConstantN('mbAbortRetryIgnore','LongInt').SetInt(ord(mbAbort) or ord(mbRetry) or ord(mbIgnore)); +{ CL.AddDelphiFunction('Function CreateMessageDialog( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons) : TForm'); CL.AddDelphiFunction('Function MessageDlg( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint) : Integer'); CL.AddDelphiFunction('Function MessageDlgPos( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint; X, Y : Integer) : Integer'); CL.AddDelphiFunction('Function MessageDlgPosHelp( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint; X, Y : Integer; const HelpFileName : string) : Integer'); CL.AddDelphiFunction('Procedure ShowMessage( const Msg : string)'); CL.AddDelphiFunction('Procedure ShowMessagePos( const Msg : string; X, Y : Integer)'); CL.AddDelphiFunction('Function InputBox( const ACaption, APrompt, ADefault : string) : string'); - CL.AddDelphiFunction('Function InputQuery( const ACaption, APrompt : string; var Value : string) : Boolean'); + CL.AddDelphiFunction('Function InputQuery( const ACaption, APrompt : string; var Value : string) : Boolean');} end; (* === run-time registration functions === *) @@ -263,7 +265,7 @@ begin Self.Left := T; end; procedure TFindDialogLeft_R(Self: TFindDialog; var T: Integer); begin T := Self.Left; end; -(*----------------------------------------------------------------------------*) +{(*----------------------------------------------------------------------------*) procedure TPrintDialogToPage_W(Self: TPrintDialog; const T: Integer); begin Self.ToPage := T; end; @@ -333,15 +335,15 @@ begin Self.Collate := T; end; (*----------------------------------------------------------------------------*) procedure TPrintDialogCollate_R(Self: TPrintDialog; var T: Boolean); -begin T := Self.Collate; end; +begin T := Self.Collate; end; } -(*----------------------------------------------------------------------------*) +{(*----------------------------------------------------------------------------*) procedure TFontDialogOnApply_W(Self: TFontDialog; const T: TFDApplyEvent); begin Self.OnApply := T; end; (*----------------------------------------------------------------------------*) procedure TFontDialogOnApply_R(Self: TFontDialog; var T: TFDApplyEvent); -begin T := Self.OnApply; end; +begin T := Self.OnApply; end; } (*----------------------------------------------------------------------------*) procedure TFontDialogOptions_W(Self: TFontDialog; const T: TFontDialogOptions); @@ -367,13 +369,13 @@ begin Self.MinFontSize := T; end; procedure TFontDialogMinFontSize_R(Self: TFontDialog; var T: Integer); begin T := Self.MinFontSize; end; -(*----------------------------------------------------------------------------*) +{(*----------------------------------------------------------------------------*) procedure TFontDialogDevice_W(Self: TFontDialog; const T: TFontDialogDevice); begin Self.Device := T; end; (*----------------------------------------------------------------------------*) procedure TFontDialogDevice_R(Self: TFontDialog; var T: TFontDialogDevice); -begin T := Self.Device; end; +begin T := Self.Device; end;} (*----------------------------------------------------------------------------*) procedure TFontDialogFont_W(Self: TFontDialog; const T: TFont); @@ -384,12 +386,12 @@ procedure TFontDialogFont_R(Self: TFontDialog; var T: TFont); begin T := Self.Font; end; (*----------------------------------------------------------------------------*) -procedure TColorDialogOptions_W(Self: TColorDialog; const T: TColorDialogOptions); +{procedure TColorDialogOptions_W(Self: TColorDialog; const T: TColorDialogOptions); begin Self.Options := T; end; (*----------------------------------------------------------------------------*) procedure TColorDialogOptions_R(Self: TColorDialog; var T: TColorDialogOptions); -begin T := Self.Options; end; +begin T := Self.Options; end; } (*----------------------------------------------------------------------------*) procedure TColorDialogCustomColors_W(Self: TColorDialog; const T: TStrings); @@ -407,13 +409,13 @@ begin Self.Color := T; end; procedure TColorDialogColor_R(Self: TColorDialog; var T: TColor); begin T := Self.Color; end; -(*----------------------------------------------------------------------------*) +{(*----------------------------------------------------------------------------*) procedure TOpenDialogOnIncludeItem_W(Self: TOpenDialog; const T: TIncludeItemEvent); begin Self.OnIncludeItem := T; end; (*----------------------------------------------------------------------------*) procedure TOpenDialogOnIncludeItem_R(Self: TOpenDialog; var T: TIncludeItemEvent); -begin T := Self.OnIncludeItem; end; +begin T := Self.OnIncludeItem; end; } (*----------------------------------------------------------------------------*) procedure TOpenDialogOnTypeChange_W(Self: TOpenDialog; const T: TNotifyEvent); @@ -515,13 +517,13 @@ begin T := Self.HistoryList; end; procedure TOpenDialogFiles_R(Self: TOpenDialog; var T: TStrings); begin T := Self.Files; end; -(*----------------------------------------------------------------------------*) +{(*----------------------------------------------------------------------------*) procedure TOpenDialogFileEditStyle_W(Self: TOpenDialog; const T: TFileEditStyle); begin Self.FileEditStyle := T; end; (*----------------------------------------------------------------------------*) procedure TOpenDialogFileEditStyle_R(Self: TOpenDialog; var T: TFileEditStyle); -begin T := Self.FileEditStyle; end; +begin T := Self.FileEditStyle; end;} (*----------------------------------------------------------------------------*) procedure TCommonDialogOnShow_W(Self: TCommonDialog; const T: TNotifyEvent); @@ -547,13 +549,13 @@ begin Self.HelpContext := T; end; procedure TCommonDialogHelpContext_R(Self: TCommonDialog; var T: THelpContext); begin T := Self.HelpContext; end; -(*----------------------------------------------------------------------------*) +{(*----------------------------------------------------------------------------*) procedure TCommonDialogCtl3D_W(Self: TCommonDialog; const T: Boolean); begin Self.Ctl3D := T; end; (*----------------------------------------------------------------------------*) procedure TCommonDialogCtl3D_R(Self: TCommonDialog; var T: Boolean); -begin T := Self.Ctl3D; end; +begin T := Self.Ctl3D; end; } (*----------------------------------------------------------------------------*) procedure TCommonDialogHandle_R(Self: TCommonDialog; var T: HWnd); @@ -598,7 +600,7 @@ end; (*----------------------------------------------------------------------------*) procedure RIRegister_TPrintDialog(CL: TPSRuntimeClassImporter); begin - with CL.Add(TPrintDialog) do +{ with CL.Add(TPrintDialog) do begin RegisterPropertyHelper(@TPrintDialogCollate_R,@TPrintDialogCollate_W,'Collate'); RegisterPropertyHelper(@TPrintDialogCopies_R,@TPrintDialogCopies_W,'Copies'); @@ -609,15 +611,15 @@ begin RegisterPropertyHelper(@TPrintDialogPrintToFile_R,@TPrintDialogPrintToFile_W,'PrintToFile'); RegisterPropertyHelper(@TPrintDialogPrintRange_R,@TPrintDialogPrintRange_W,'PrintRange'); RegisterPropertyHelper(@TPrintDialogToPage_R,@TPrintDialogToPage_W,'ToPage'); - end; + end; } end; (*----------------------------------------------------------------------------*) procedure RIRegister_TPrinterSetupDialog(CL: TPSRuntimeClassImporter); begin - with CL.Add(TPrinterSetupDialog) do +{ with CL.Add(TPrinterSetupDialog) do begin - end; + end;} end; (*----------------------------------------------------------------------------*) @@ -626,11 +628,11 @@ begin with CL.Add(TFontDialog) do begin RegisterPropertyHelper(@TFontDialogFont_R,@TFontDialogFont_W,'Font'); - RegisterPropertyHelper(@TFontDialogDevice_R,@TFontDialogDevice_W,'Device'); +// RegisterPropertyHelper(@TFontDialogDevice_R,@TFontDialogDevice_W,'Device'); RegisterPropertyHelper(@TFontDialogMinFontSize_R,@TFontDialogMinFontSize_W,'MinFontSize'); RegisterPropertyHelper(@TFontDialogMaxFontSize_R,@TFontDialogMaxFontSize_W,'MaxFontSize'); RegisterPropertyHelper(@TFontDialogOptions_R,@TFontDialogOptions_W,'Options'); - RegisterPropertyHelper(@TFontDialogOnApply_R,@TFontDialogOnApply_W,'OnApply'); +// RegisterPropertyHelper(@TFontDialogOnApply_R,@TFontDialogOnApply_W,'OnApply'); end; end; @@ -641,7 +643,7 @@ begin begin RegisterPropertyHelper(@TColorDialogColor_R,@TColorDialogColor_W,'Color'); RegisterPropertyHelper(@TColorDialogCustomColors_R,@TColorDialogCustomColors_W,'CustomColors'); - RegisterPropertyHelper(@TColorDialogOptions_R,@TColorDialogOptions_W,'Options'); +// RegisterPropertyHelper(@TColorDialogOptions_R,@TColorDialogOptions_W,'Options'); end; end; @@ -658,7 +660,7 @@ procedure RIRegister_TOpenDialog(CL: TPSRuntimeClassImporter); begin with CL.Add(TOpenDialog) do begin - RegisterPropertyHelper(@TOpenDialogFileEditStyle_R,@TOpenDialogFileEditStyle_W,'FileEditStyle'); +// RegisterPropertyHelper(@TOpenDialogFileEditStyle_R,@TOpenDialogFileEditStyle_W,'FileEditStyle'); RegisterPropertyHelper(@TOpenDialogFiles_R,nil,'Files'); RegisterPropertyHelper(@TOpenDialogHistoryList_R,@TOpenDialogHistoryList_W,'HistoryList'); RegisterPropertyHelper(@TOpenDialogDefaultExt_R,@TOpenDialogDefaultExt_W,'DefaultExt'); @@ -672,7 +674,8 @@ begin RegisterPropertyHelper(@TOpenDialogOnFolderChange_R,@TOpenDialogOnFolderChange_W,'OnFolderChange'); RegisterPropertyHelper(@TOpenDialogOnSelectionChange_R,@TOpenDialogOnSelectionChange_W,'OnSelectionChange'); RegisterPropertyHelper(@TOpenDialogOnTypeChange_R,@TOpenDialogOnTypeChange_W,'OnTypeChange'); - RegisterPropertyHelper(@TOpenDialogOnIncludeItem_R,@TOpenDialogOnIncludeItem_W,'OnIncludeItem'); + RegisterMethod(@TOpenDialog.execute,'EXECUTE'); +// RegisterPropertyHelper(@TOpenDialogOnIncludeItem_R,@TOpenDialogOnIncludeItem_W,'OnIncludeItem'); end; end; @@ -682,7 +685,7 @@ begin with CL.Add(TCommonDialog) do begin RegisterPropertyHelper(@TCommonDialogHandle_R,nil,'Handle'); - RegisterPropertyHelper(@TCommonDialogCtl3D_R,@TCommonDialogCtl3D_W,'Ctl3D'); +// RegisterPropertyHelper(@TCommonDialogCtl3D_R,@TCommonDialogCtl3D_W,'Ctl3D'); RegisterPropertyHelper(@TCommonDialogHelpContext_R,@TCommonDialogHelpContext_W,'HelpContext'); RegisterPropertyHelper(@TCommonDialogOnClose_R,@TCommonDialogOnClose_W,'OnClose'); RegisterPropertyHelper(@TCommonDialogOnShow_R,@TCommonDialogOnShow_W,'OnShow'); diff --git a/Units/PascalScript/uPSR_controls.pas b/Units/PascalScript/uPSR_controls.pas index 72d9490..686beab 100644 --- a/Units/PascalScript/uPSR_controls.pas +++ b/Units/PascalScript/uPSR_controls.pas @@ -49,6 +49,9 @@ procedure TCONTROLSHOWHINT_W(Self: TCONTROL; T: BOOLEAN); begin Self.SHOWHINT := procedure TCONTROLSHOWHINT_R(Self: TCONTROL; var T: BOOLEAN); begin T := Self.SHOWHINT; end; procedure TCONTROLENABLED_W(Self: TCONTROL; T: BOOLEAN); begin Self.ENABLED := T; end; procedure TCONTROLENABLED_R(Self: TCONTROL; var T: BOOLEAN); begin T := Self.ENABLED; end; +procedure TControlCaption_W(Self: TCONTROL; T: String); begin Self.Caption := T; end; +procedure TControlCaption_R(Self: TCONTROL; var T: String); begin T := Self.Caption; end; +procedure TControlBeginDrag(Self : TControl;Immediate : boolean); begin self.BeginDrag(Immediate); end; procedure RIRegisterTControl(Cl: TPSRuntimeClassImporter); begin @@ -71,7 +74,7 @@ begin RegisterPropertyHelper(@TControlClientWidthR, @TControlClientWidthW, 'CLIENTWIDTH'); RegisterPropertyHelper(@TControlVisibleR, @TControlVisibleW, 'VISIBLE'); RegisterPropertyHelper(@TCONTROLENABLED_R, @TCONTROLENABLED_W, 'ENABLED'); - + RegisterPropertyHelper(@TControlCaption_R,@TControlCaption_W,'CAPTION'); RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT'); {$IFNDEF PS_MINIVCL} @@ -79,8 +82,8 @@ begin RegisterMethod(@TControl.HasParent, 'HASPARENT'); RegisterMethod(@TCONTROL.CLIENTTOSCREEN, 'CLIENTTOSCREEN'); RegisterMethod(@TCONTROL.DRAGGING, 'DRAGGING'); + RegisterMethod(@TControlBeginDrag, 'BEGINDRAG'); {$IFNDEF FPC} - RegisterMethod(@TCONTROL.BEGINDRAG, 'BEGINDRAG'); RegisterMethod(@TCONTROL.ENDDRAG, 'ENDDRAG'); {$ENDIF} {$IFNDEF CLX} diff --git a/Units/PascalScript/uPSR_extctrls.pas b/Units/PascalScript/uPSR_extctrls.pas index b9c059a..b653dae 100644 --- a/Units/PascalScript/uPSR_extctrls.pas +++ b/Units/PascalScript/uPSR_extctrls.pas @@ -30,7 +30,7 @@ uses {$IFDEF CLX} QExtCtrls, QGraphics; {$ELSE} - ExtCtrls, Graphics; + ExtCtrls, Graphics,classes; {$ENDIF} procedure RIRegisterTSHAPE(Cl: TPSRuntimeClassImporter); @@ -82,15 +82,28 @@ procedure RIRegisterTPANEL(Cl: TPSRuntimeClassImporter); begin Cl.Add(TPANEL); end; +procedure TPagePageIndex_R(Self: TPAGE; var T: INTEGER); begin T := Self.PageIndex; end; +procedure TPagePageIndex_W(Self: TPAGE; T: INTEGER); begin Self.PageIndex := T; end; +procedure TPageOnShow_R(Self: TPAGE; var T: TNotifyEvent); begin T := Self.OnShow; end; +procedure TPageOnShow_W(Self: TPAGE; T: TNotifyEvent); begin Self.OnShow := T; end; {$IFNDEF CLX} procedure RIRegisterTPAGE(Cl: TPSRuntimeClassImporter); begin - Cl.Add(TPAGE); + with Cl.Add(TPAGE) do + begin + RegisterPropertyHelper(@TPagePageIndex_R,@TPagePageIndex_W,'PageIndex'); + RegisterEventPropertyHelper(@TPageOnShow_R,@TPageOnShow_W,'OnShow'); + end; end; +procedure TNoteBookPageCount_R(Self: TNoteBook; var T: INTEGER); begin T := Self.PageCount; end; procedure RIRegisterTNOTEBOOK(Cl: TPSRuntimeClassImporter); begin - Cl.Add(TNOTEBOOK); + with Cl.Add(TNOTEBOOK) do + begin + RegisterMethod(@TNoteBook.TabIndexAtClientPos,'TABINDEXATCLIENTPOS'); + RegisterPropertyHelper(@TNoteBookPageCount_R,nil,'PAGECOUNT'); + end; end; {$IFNDEF FPC} diff --git a/Units/PascalScript/uPSR_stdctrls.pas b/Units/PascalScript/uPSR_stdctrls.pas index 8610e96..4f511ad 100644 --- a/Units/PascalScript/uPSR_stdctrls.pas +++ b/Units/PascalScript/uPSR_stdctrls.pas @@ -217,7 +217,8 @@ procedure TCUSTOMLISTBOXSELECTED_R(Self: TCUSTOMLISTBOX; var T: BOOLEAN; t1: INT procedure TCUSTOMLISTBOXSELECTED_W(Self: TCUSTOMLISTBOX; T: BOOLEAN; t1: INTEGER); begin Self.SELECTED[t1] := T; end; procedure TCUSTOMLISTBOXTOPINDEX_R(Self: TCUSTOMLISTBOX; var T: INTEGER); begin T := Self.TOPINDEX; end; procedure TCUSTOMLISTBOXTOPINDEX_W(Self: TCUSTOMLISTBOX; T: INTEGER); begin Self.TOPINDEX := T; end; - +procedure TCUSTOMLISTBOXITEMHEIGHT_R(Self: TCUSTOMLISTBOX; var T: INTEGER); begin T := Self.ItemHeight; end; +procedure TCUSTOMLISTBOXITEMHEIGHT_W(Self: TCUSTOMLISTBOX; T: INTEGER); begin Self.ItemHeight := T; end; procedure RIRegisterTCUSTOMLISTBOX(Cl: TPSRuntimeClassImporter); begin @@ -227,6 +228,7 @@ begin RegisterPropertyHelper(@TCUSTOMLISTBOXITEMINDEX_R, @TCUSTOMLISTBOXITEMINDEX_W, 'ITEMINDEX'); RegisterPropertyHelper(@TCUSTOMLISTBOXSELCOUNT_R, nil, 'SELCOUNT'); RegisterPropertyHelper(@TCUSTOMLISTBOXSELECTED_R, @TCUSTOMLISTBOXSELECTED_W, 'SELECTED'); + RegisterPropertyHelper(@TCUSTOMLISTBOXITEMHEIGHT_R,@TCUSTOMLISTBOXITEMHEIGHT_W,'ITEMHEIGHT'); {$IFNDEF PS_MINIVCL} RegisterMethod(@TCUSTOMLISTBOX.CLEAR, 'CLEAR');