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');