1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-24 18:22:25 -05:00

Merge ssh://villavu.com:54367/simba

This commit is contained in:
Niels 2010-05-04 13:41:12 +02:00
commit b5cf19a770
26 changed files with 1210 additions and 136 deletions

3
Doc/TODO Normal file
View File

@ -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

View File

@ -11,7 +11,7 @@ AppVerName=Simba 1.0 Beta
AppPublisherURL=http://simba.villavu.com/ AppPublisherURL=http://simba.villavu.com/
AppSupportURL=http://simba.villavu.com/ AppSupportURL=http://simba.villavu.com/
AppUpdatesURL=http://simba.villavu.com/ AppUpdatesURL=http://simba.villavu.com/
DefaultDirName={pf}\Simba DefaultDirName={sd}\Simba
DefaultGroupName=Simba DefaultGroupName=Simba
OutputDir=C:\Remake\Install\windows\ OutputDir=C:\Remake\Install\windows\
OutputBaseFilename=setup OutputBaseFilename=setup

View File

@ -1,10 +1,10 @@
object DebugImgForm: TDebugImgForm object DebugImgForm: TDebugImgForm
Left = 491 Left = 1335
Height = 300 Height = 300
Top = 266 Top = 172
Width = 400 Width = 400
BorderIcons = [biSystemMenu, biMinimize] BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsToolWindow BorderStyle = bsSingle
Caption = 'DebugImgForm' Caption = 'DebugImgForm'
ClientHeight = 300 ClientHeight = 300
ClientWidth = 400 ClientWidth = 400

View File

@ -1,18 +1,19 @@
object Form1: TForm1 object Form1: TForm1
Left = 0 Left = 150
Height = 240 Height = 623
Top = 0 Top = 69
Width = 320 Width = 660
AllowDropFiles = True AllowDropFiles = True
Caption = 'THA FUKING SIMBA' Caption = 'THA FUKING SIMBA'
ClientHeight = 220 ClientHeight = 603
ClientWidth = 320 ClientWidth = 660
KeyPreview = True KeyPreview = True
Menu = MainMenu Menu = MainMenu
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnDropFiles = FormDropFiles OnDropFiles = FormDropFiles
OnHide = doOnHide
OnShortCut = FormShortCuts OnShortCut = FormShortCuts
LCLVersion = '0.9.29' LCLVersion = '0.9.29'
Visible = True Visible = True
@ -20,7 +21,7 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 24 Height = 24
Top = 0 Top = 0
Width = 320 Width = 660
Caption = 'ToolBar1' Caption = 'ToolBar1'
Images = Mufasa_Image_List Images = Mufasa_Image_List
ParentShowHint = False ParentShowHint = False
@ -82,40 +83,40 @@ object Form1: TForm1
Action = ActionClearDebug Action = ActionClearDebug
end end
object TB_PickColour: TToolButton object TB_PickColour: TToolButton
Left = 1 Left = 316
Hint = 'Pick a color' Hint = 'Pick a color'
Top = 24 Top = 2
Caption = 'TB_PickColour' Caption = 'TB_PickColour'
ImageIndex = 0 ImageIndex = 0
OnClick = ButtonPickClick OnClick = ButtonPickClick
end end
object TB_SelectClient: TToolButton object TB_SelectClient: TToolButton
Left = 24 Left = 339
Hint = 'Select a client' Hint = 'Select a client'
Top = 24 Top = 2
Caption = 'TB_SelectClient' Caption = 'TB_SelectClient'
ImageIndex = 2 ImageIndex = 2
OnMouseDown = ButtonSelectorDown OnMouseDown = ButtonSelectorDown
end end
object ToolButton8: TToolButton object ToolButton8: TToolButton
Left = 47 Left = 362
Top = 24 Top = 2
Width = 4 Width = 4
Caption = 'ToolButton8' Caption = 'ToolButton8'
Style = tbsDivider Style = tbsDivider
end end
object TB_ReloadPlugins: TToolButton object TB_ReloadPlugins: TToolButton
Left = 51 Left = 366
Hint = 'Reload plugins' Hint = 'Reload plugins'
Top = 24 Top = 2
Caption = 'TB_ReloadPlugins' Caption = 'TB_ReloadPlugins'
Enabled = False Enabled = False
ImageIndex = 13 ImageIndex = 13
end end
object TB_Tray: TToolButton object TB_Tray: TToolButton
Left = 74 Left = 389
Hint = 'Minimize to tray' Hint = 'Minimize to tray'
Top = 24 Top = 2
Caption = 'TB_Tray' Caption = 'TB_Tray'
ImageIndex = 17 ImageIndex = 17
OnClick = ButtonTrayClick OnClick = ButtonTrayClick
@ -157,16 +158,16 @@ object Form1: TForm1
Enabled = False Enabled = False
end end
object ToolButton3: TToolButton object ToolButton3: TToolButton
Left = 120 Left = 435
Top = 24 Top = 2
Width = 4 Width = 4
Caption = 'ToolButton3' Caption = 'ToolButton3'
Style = tbsDivider Style = tbsDivider
end end
object TT_Update: TToolButton object TT_Update: TToolButton
Left = 124 Left = 439
Hint = 'A new update is available' Hint = 'A new update is available'
Top = 24 Top = 2
Caption = 'TT_Update' Caption = 'TT_Update'
ImageIndex = 1 ImageIndex = 1
OnClick = TT_UpdateClick OnClick = TT_UpdateClick
@ -198,17 +199,17 @@ object Form1: TForm1
Style = tbsDivider Style = tbsDivider
end end
object TT_Console: TToolButton object TT_Console: TToolButton
Left = 97 Left = 412
Hint = 'Hide/Show Console' Hint = 'Hide/Show Console'
Top = 24 Top = 2
Action = ActionConsole Action = ActionConsole
end end
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 22 Height = 23
Top = 198 Top = 580
Width = 320 Width = 660
Panels = < Panels = <
item item
Width = 60 Width = 60
@ -229,17 +230,17 @@ object Form1: TForm1
object PanelMemo: TPanel object PanelMemo: TPanel
Left = 0 Left = 0
Height = 154 Height = 154
Top = 44 Top = 426
Width = 320 Width = 660
Align = alBottom Align = alBottom
ClientHeight = 154 ClientHeight = 154
ClientWidth = 320 ClientWidth = 660
TabOrder = 2 TabOrder = 2
object Memo1: TMemo object Memo1: TMemo
Left = 1 Left = 1
Height = 152 Height = 152
Top = 1 Top = 1
Width = 318 Width = 658
Align = alClient Align = alClient
Font.Height = -13 Font.Height = -13
Font.Name = 'Courier New' Font.Name = 'Courier New'
@ -252,29 +253,29 @@ object Form1: TForm1
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 39 Top = 421
Width = 320 Width = 660
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
end end
object ScriptPanel: TPanel object ScriptPanel: TPanel
Left = 0 Left = 0
Height = 15 Height = 397
Top = 24 Top = 24
Width = 320 Width = 660
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 15 ClientHeight = 397
ClientWidth = 320 ClientWidth = 660
DockSite = True DockSite = True
TabOrder = 4 TabOrder = 4
OnDockDrop = ScriptPanelDockDrop OnDockDrop = ScriptPanelDockDrop
OnDockOver = ScriptPanelDockOver OnDockOver = ScriptPanelDockOver
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 155 Left = 155
Height = 0 Height = 362
Top = 0 Top = 0
Width = 165 Width = 505
Align = alClient Align = alClient
Images = Mufasa_Image_List Images = Mufasa_Image_List
PopupMenu = TabPopup PopupMenu = TabPopup
@ -291,12 +292,12 @@ object Form1: TForm1
object SearchPanel: TPanel object SearchPanel: TPanel
Left = 0 Left = 0
Height = 35 Height = 35
Top = -20 Top = 362
Width = 320 Width = 660
Align = alBottom Align = alBottom
BevelOuter = bvSpace BevelOuter = bvSpace
ClientHeight = 35 ClientHeight = 35
ClientWidth = 320 ClientWidth = 660
TabOrder = 1 TabOrder = 1
Visible = False Visible = False
object SpeedButtonSearch: TSpeedButton object SpeedButtonSearch: TSpeedButton
@ -387,7 +388,7 @@ object Form1: TForm1
end end
object LabeledEditSearch: TLabeledEdit object LabeledEditSearch: TLabeledEdit
Left = 104 Left = 104
Height = 23 Height = 21
Top = 6 Top = 6
Width = 174 Width = 174
EditLabel.AnchorSideLeft.Control = LabeledEditSearch EditLabel.AnchorSideLeft.Control = LabeledEditSearch
@ -395,10 +396,10 @@ object Form1: TForm1
EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = LabeledEditSearch EditLabel.AnchorSideRight.Control = LabeledEditSearch
EditLabel.AnchorSideBottom.Control = LabeledEditSearch EditLabel.AnchorSideBottom.Control = LabeledEditSearch
EditLabel.Left = 71 EditLabel.Left = 73
EditLabel.Height = 16 EditLabel.Height = 14
EditLabel.Top = 9 EditLabel.Top = 9
EditLabel.Width = 30 EditLabel.Width = 28
EditLabel.Caption = 'Find: ' EditLabel.Caption = 'Find: '
EditLabel.ParentColor = False EditLabel.ParentColor = False
LabelPosition = lpLeft LabelPosition = lpLeft
@ -411,9 +412,9 @@ object Form1: TForm1
end end
object CheckBoxMatchCase: TCheckBox object CheckBoxMatchCase: TCheckBox
Left = 320 Left = 320
Height = 19 Height = 17
Top = 7 Top = 7
Width = 80 Width = 72
Caption = 'Match case' Caption = 'Match case'
OnClick = CheckBoxMatchCaseClick OnClick = CheckBoxMatchCaseClick
TabOrder = 1 TabOrder = 1
@ -421,36 +422,38 @@ object Form1: TForm1
end end
object SplitterFunctionList: TSplitter object SplitterFunctionList: TSplitter
Left = 150 Left = 150
Height = 0 Height = 362
Top = 0 Top = 0
Width = 5 Width = 5
OnCanResize = SplitterFunctionListCanResize OnCanResize = SplitterFunctionListCanResize
Visible = False Visible = False
end end
inline frmFunctionList: TFunctionListFrame inline frmFunctionList: TFunctionListFrame
Height = 0 Height = 362
Width = 150 Width = 150
ClientHeight = 0 ClientHeight = 362
ClientWidth = 150 ClientWidth = 150
OnEndDock = nil OnEndDock = nil
TabOrder = 3 TabOrder = 3
inherited FunctionList: TTreeView inherited FunctionList: TTreeView
Height = 0 Height = 323
Top = 1 Top = 18
Width = 150 Width = 150
DefaultItemHeight = 15
OnChange = FunctionListChange OnChange = FunctionListChange
OnEnter = FunctionListEnter OnEnter = FunctionListEnter
OnExit = FunctionListExit OnExit = FunctionListExit
end end
inherited editSearchList: TEdit inherited editSearchList: TEdit
Top = -23 Height = 21
Top = 341
Width = 150 Width = 150
OnExit = editSearchListExit OnExit = editSearchListExit
OnKeyDown = editSearchListKeyDown OnKeyDown = editSearchListKeyDown
OnKeyPress = editSearchListKeyPress OnKeyPress = editSearchListKeyPress
end end
inherited FunctionListLabel: TLabel inherited FunctionListLabel: TLabel
Top = 0 Height = 14
Width = 146 Width = 146
end end
end end

View File

@ -46,7 +46,7 @@ uses
CastaliaSimplePasPar, v_AutoCompleteForm, PSDump; CastaliaSimplePasPar, v_AutoCompleteForm, PSDump;
const const
SimbaVersion = 637; SimbaVersion = 650;
type type
@ -248,6 +248,7 @@ type
procedure ChangeMouseStatus(Sender: TObject); procedure ChangeMouseStatus(Sender: TObject);
procedure CheckBoxMatchCaseClick(Sender: TObject); procedure CheckBoxMatchCaseClick(Sender: TObject);
procedure CloseFindPanel; procedure CloseFindPanel;
procedure doOnHide(Sender: TObject);
procedure editSearchListExit(Sender: TObject); procedure editSearchListExit(Sender: TObject);
procedure editSearchListKeyDown(Sender: TObject; var Key: Word; procedure editSearchListKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
@ -1389,8 +1390,8 @@ begin
FormWritelnEx('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now'); FormWritelnEx('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now');
Thread.SetPaths(ScriptPath,AppPath,Includepath,PluginPath,fontPath); 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'); loadFontsOnScriptStart := (lowercase(LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True')) = 'true');
// Copy our current fonts // Copy our current fonts
@ -1715,6 +1716,16 @@ begin
CurrScript.SynEdit.SetFocus; CurrScript.SynEdit.SetFocus;
end; 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; procedure TForm1.StopCodeCompletion;
begin begin
CodeCompletionForm.Hide; CodeCompletionForm.Hide;

View File

@ -105,6 +105,11 @@ begin;
result := CurrThread.Client.MBitmaps[Bmp].FastGetPixels(TPA); result := CurrThread.Client.MBitmaps[Bmp].FastGetPixels(TPA);
end; 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; procedure ps_FastSetPixel(Bmp,x,y : integer; Color : TColor); extdecl;
begin begin
CurrThread.Client.MBitmaps[bmp].FastSetPixel(x,y,color); CurrThread.Client.MBitmaps[bmp].FastSetPixel(x,y,color);
@ -299,3 +304,15 @@ procedure ps_FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const
begin begin
CurrThread.Client.MBitmaps[bitmap].FloodFill(startPoint,searchcol,replacecol); CurrThread.Client.MBitmaps[bitmap].FloodFill(startPoint,searchcol,replacecol);
end; 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;

View File

@ -110,3 +110,8 @@ begin;
Tempini.DeleteKey(section,keyname); Tempini.DeleteKey(section,keyname);
tempini.free; tempini.free;
end; end;
function ps_ExtractFileExt(const FileName: string): string; extdecl;
begin
result := ExtractFileExt(filename);
end;

View File

@ -163,3 +163,13 @@ function ps_ln(x : extended) : extended;extdecl;
begin begin
result := ln(x); result := ln(x);
end; end;
function ps_inttohex(value : integer) : string;
begin
result := IntToHex(value,1);
end;
function ps_hextoint(hex : string) : integer;
begin
result := StrToInt('$' + hex);
end;

View File

@ -52,3 +52,15 @@ function ps_LoadSystemFont(const SysFont : TFont; const FontName : string) : boo
begin begin
result := CurrThread.Client.MOCR.Fonts.LoadSystemFont(SysFont,FontName); result := CurrThread.Client.MOCR.Fonts.LoadSystemFont(SysFont,FontName);
end; 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;

View File

@ -163,3 +163,13 @@ function ps_Random(Int: integer): integer; extdecl;
begin begin
result := Random(int); result := Random(int);
end; 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;

View File

@ -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_InRange,'function InRange(const value,min,max : integer) : boolean;');
AddFunction(@ps_logn,'function logn(base, x : extended): extended;'); AddFunction(@ps_logn,'function logn(base, x : extended): extended;');
AddFunction(@ps_ln,'function ln(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} {window}
SetCurrSection('Window'); SetCurrSection('Window');
@ -109,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_WriteINI,'procedure WriteINI(const Section, KeyName, NewString, FileName: string);');
AddFunction(@ps_ReadINI,'function ReadINI(const Section, KeyName, FileName: string): string;'); AddFunction(@ps_ReadINI,'function ReadINI(const Section, KeyName, FileName: string): string;');
AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName: string);'); AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName: string);');
AddFunction(@ps_ExtractFileExt,'function ExtractFileExt(const FileName: string): string;');
{other} {other}
SetCurrSection('Other'); SetCurrSection('Other');
@ -135,8 +138,7 @@ AddFunction(@ps_PlaySound,'procedure PlaySound( Sound : string);');
AddFunction(@ps_StopSound,'procedure StopSound;'); AddFunction(@ps_StopSound,'procedure StopSound;');
AddFunction(@ps_SetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: TVariantArray): boolean;'); 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_GetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: TVariantArray): boolean;');
AddFunction(@ps_InputQuery,'function InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;');
{string} {string}
SetCurrSection('String'); SetCurrSection('String');
@ -251,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_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_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_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} {Bitmaps}
SetCurrSection('Bitmaps'); SetCurrSection('Bitmaps');
@ -270,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_FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
AddFunction(@ps_FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;'); AddFunction(@ps_FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
AddFunction(@ps_FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;'); 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_FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor);');
AddFunction(@ps_FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);'); AddFunction(@ps_FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
AddFunction(@ps_SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);'); AddFunction(@ps_SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
@ -302,6 +307,8 @@ AddFunction(@ps_DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap: integer; AT
AddFunction(@ps_DrawBitmap,'procedure DrawBitmap(Bmp: Integer; Dest: TCanvas; x, y: Integer);'); 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_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_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} {tpa}
SetCurrSection('TPA'); SetCurrSection('TPA');

View File

@ -72,7 +72,10 @@ type
FuncPtr : Pointer; FuncPtr : Pointer;
end; end;
TExpMethodArr = array of TExpMethod; TExpMethodArr = array of TExpMethod;
TInputQueryData = record
ACaption, APrompt,Value : String;
Res : boolean;
end;
{ TMThread } { TMThread }
TMThread = class(TThread) TMThread = class(TThread)
@ -99,12 +102,14 @@ type
StartTime : LongWord; StartTime : LongWord;
Sett: TMMLSettingsSandbox; Sett: TMMLSettingsSandbox;
InputQueryData : TInputQueryData;//We need this for InputQuery
SyncInfo : PSyncInfo; //We need this for callthreadsafe SyncInfo : PSyncInfo; //We need this for callthreadsafe
ErrorData : PErrorData; //We need this for thread-safety etc ErrorData : PErrorData; //We need this for thread-safety etc
OnError : TOnError; //Error handeler OnError : TOnError; //Error handeler
CompileOnly : boolean; CompileOnly : boolean;
procedure mInputQuery;
procedure HandleError(ErrorRow,ErrorCol,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string); procedure HandleError(ErrorRow,ErrorCol,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string);
function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean; function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean;
function LoadFile(ParentFile : string; var filename, contents: string): boolean; function LoadFile(ParentFile : string; var filename, contents: string): boolean;
@ -207,8 +212,9 @@ uses
stringutil, //String st00f stringutil, //String st00f
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
uPSR_menus, uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs,
files, files,
dialogs,
uPSR_extctrls, //Runtime-libs uPSR_extctrls, //Runtime-libs
Graphics, //For Graphics types Graphics, //For Graphics types
math, //Maths! math, //Maths!
@ -347,6 +353,12 @@ begin
self.Client.MFiles.WriteFileEvent := AValue;; self.Client.MFiles.WriteFileEvent := AValue;;
end; 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); procedure TMThread.HandleError(ErrorRow,ErrorCol, ErrorPosition: integer; ErrorStr: string; ErrorType: TErrorType; ErrorModule : string);
begin begin
if OnError = nil then if OnError = nil then
@ -873,6 +885,8 @@ begin
SIRegister_Forms(x); SIRegister_Forms(x);
SIRegister_ExtCtrls(x); SIRegister_ExtCtrls(x);
SIRegister_Menus(x); SIRegister_Menus(x);
SIRegister_ComCtrls(x);
SIRegister_Dialogs(x);
{$I PSInc/pscompile.inc} {$I PSInc/pscompile.inc}
SIRegister_Mufasa(x); SIRegister_Mufasa(x);
with x.AddFunction('procedure writeln;').decl do with x.AddFunction('procedure writeln;').decl do
@ -914,6 +928,8 @@ begin
RIRegister_ExtCtrls(x); RIRegister_ExtCtrls(x);
RIRegister_Menus(x); RIRegister_Menus(x);
RIRegister_Mufasa(x); RIRegister_Mufasa(x);
RIRegister_ComCtrls(x);
RIRegister_Dialogs(x);
se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil); se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil);
se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil); se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil);
se.RegisterFunctionName('SWAP',@swap_,nil,nil); se.RegisterFunctionName('SWAP',@swap_,nil,nil);

View File

@ -143,6 +143,7 @@ begin
end; end;
SP_OnTerminate : SP_OnTerminate :
begin begin
FOnTerminateProcs.Clear;
for i := 0 to high(value) do for i := 0 to high(value) do
FOnTerminateProcs.Add(Value[i]); FOnTerminateProcs.Add(Value[i]);
FProperties := FProperties + [prop]; FProperties := FProperties + [prop];

View File

@ -63,6 +63,7 @@ type
function CreateTPA(SearchCol : TColor) : TPointArray; function CreateTPA(SearchCol : TColor) : TPointArray;
function FastGetPixel(x,y : integer) : TColor; function FastGetPixel(x,y : integer) : TColor;
function FastGetPixels(Points : TPointArray) : TIntegerArray; function FastGetPixels(Points : TPointArray) : TIntegerArray;
function GetAreaColors(xs,ys,xe,ye : integer) : T2DIntArray;
procedure FastDrawClear(Color : TColor); procedure FastDrawClear(Color : TColor);
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap); procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
procedure FastReplaceColor(OldColor, NewColor: TColor); procedure FastReplaceColor(OldColor, NewColor: TColor);
@ -91,6 +92,7 @@ type
procedure SetTransparentColor(Col : TColor); procedure SetTransparentColor(Col : TColor);
function GetTransparentColor : TColor; function GetTransparentColor : TColor;
property TransparentColorSet : boolean read FTransparentSet; property TransparentColorSet : boolean read FTransparentSet;
procedure SetAlphaValue(const value : byte);
constructor Create; constructor Create;
destructor Destroy;override; destructor Destroy;override;
end; end;
@ -120,7 +122,8 @@ type
end; end;
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage); 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 implementation
uses uses
@ -162,6 +165,68 @@ Begin
RawImage.Data := PByte(Ptr); RawImage.Data := PByte(Ptr);
End; 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; function Min(a,b:integer) : integer;
begin begin
if a < b then if a < b then
@ -491,6 +556,7 @@ begin
ValidatePoint(StartPT.x,StartPT.y); ValidatePoint(StartPT.x,StartPT.y);
Search := LongWord(RGBToBGR(SearchCol)); Search := LongWord(RGBToBGR(SearchCol));
Replace := LongWord(RGBToBGR(ReplaceCol)); 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. if LongWord(FData[StartPT.y * w + StartPT.x]) <> Search then //Only add items to the stack that are the searchcol.
Exit; Exit;
SetLength(Stack,w * h); SetLength(Stack,w * h);
@ -781,6 +847,18 @@ begin
Result[i] := BGRToRGB(FData[Points[i].y*w + Points[i].x]); Result[i] := BGRToRGB(FData[Points[i].y*w + Points[i].x]);
end; 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); procedure TMufasaBitmap.SetTransparentColor(Col: TColor);
begin begin
self.FTransparentSet:= True; self.FTransparentSet:= True;
@ -795,6 +873,14 @@ begin
raise Exception.CreateFmt('Transparent color for Bitmap[%d] isn''t set',[index]); raise Exception.CreateFmt('Transparent color for Bitmap[%d] isn''t set',[index]);
end; 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); procedure TMufasaBitmap.FastDrawClear(Color: TColor);
var var
i : integer; i : integer;

View File

@ -37,7 +37,7 @@ type
TMDTM = class(TObject) TMDTM = class(TObject)
private private
Client: TObject; Client: TObject;
DTMList: Array Of pDTM; DTMList: Array Of PpDTM;
FreeSpots: Array Of Integer; FreeSpots: Array Of Integer;
procedure CheckIndex(index : integer); procedure CheckIndex(index : integer);
public public
@ -90,8 +90,8 @@ begin
end; end;
if not b then if not b then
begin; begin;
if DTMList[i].n <> '' then if DTMList[i]^.n <> '' then
WriteStr := WriteStr + DTMList[i].n + ', ' WriteStr := WriteStr + DTMList[i]^.n + ', '
else else
WriteStr := WriteStr + inttostr(i) + ', '; WriteStr := WriteStr + inttostr(i) + ', ';
FreeDTM(i); FreeDTM(i);
@ -171,7 +171,7 @@ end;
procedure TMDTM.CheckIndex(index: integer); procedure TMDTM.CheckIndex(index: integer);
begin 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]); raise Exception.CreateFmt('The given DTM Index[%d] doesn''t exist',[index]);
end; end;
@ -185,20 +185,24 @@ end;
/\} /\}
function TMDTM.AddpDTM(const d: pDTM): Integer; function TMDTM.AddpDTM(const d: pDTM): Integer;
var
NewDTM : PpDTM;
begin begin
New(NewDTM);
NewDTM^ := d;
if Length(FreeSpots) > 0 then if Length(FreeSpots) > 0 then
begin begin
DTMList[FreeSpots[High(FreeSpots)]] := d;
Result := FreeSpots[High(FreeSpots)]; Result := FreeSpots[High(FreeSpots)];
SetLength(FreeSpots, High(FreeSpots)); SetLength(FreeSpots, High(FreeSpots));
end end
else else
begin begin
SetLength(DTMList, Length(DTMList) + 1); SetLength(DTMList, Length(DTMList) + 1);
DTMList[High(DTMList)] := d;
Result := High(DTMList); Result := High(DTMList);
end; end;
NormalizeDTM(DTMList[result]); DTMList[Result] := NewDTM;
NormalizeDTM(DTMList[result]^);
end; end;
{/\ {/\
@ -209,13 +213,13 @@ end;
function TMDTM.GetDTM(index: Integer) :pDTM; function TMDTM.GetDTM(index: Integer) :pDTM;
begin begin
CheckIndex(index); CheckIndex(index);
result := DTMList[index]; result := DTMList[index]^;
end; end;
procedure TMDTM.SetDTMName(DTM: Integer;const s: string); procedure TMDTM.SetDTMName(DTM: Integer;const s: string);
begin begin
CheckIndex(DTM); CheckIndex(DTM);
DTMList[DTM].n := s; DTMList[DTM]^.n := s;
end; end;
{/\ {/\
@ -227,14 +231,19 @@ end;
procedure TMDTM.FreeDTM(DTM: Integer); procedure TMDTM.FreeDTM(DTM: Integer);
begin begin
CheckIndex(DTM); CheckIndex(DTM);
SetLength(DTMList[DTM].p, 0); with DTMList[DTM]^ do
SetLength(DTMList[DTM].c, 0); begin
SetLength(DTMList[DTM].t, 0); SetLength(p, 0);
SetLength(DTMList[DTM].asz, 0); SetLength(c, 0);
SetLength(DTMList[DTM].ash, 0); SetLength(t, 0);
SetLength(DTMList[DTM].bp,0); SetLength(asz, 0);
DTMList[DTM].l := 0; SetLength(ash, 0);
DTMList[DTM].n := ''; SetLength(bp,0);
l := 0;
n := '';
end;
Dispose(DTMList[DTM]);
DTMList[DTM] := nil;
SetLength(FreeSpots, Length(FreeSpots) + 1); SetLength(FreeSpots, Length(FreeSpots) + 1);
FreeSpots[High(FreeSpots)] := DTM; FreeSpots[High(FreeSpots)] := DTM;
end; end;

View File

@ -214,9 +214,9 @@ begin
F.Name := F.Name + '_s'; F.Name := F.Name + '_s';
f.Data := InitOCR( LoadGlyphMasks(FPath + Name + DS, Shadow)); f.Data := InitOCR( LoadGlyphMasks(FPath + Name + DS, Shadow));
Fonts.Add(f); Fonts.Add(f);
{$IFDEF FONTDEBUG} {{$IFDEF FONTDEBUG}
TClient(Client).Writeln('Loaded Font ' + f.Name); TClient(Client).Writeln('Loaded Font ' + f.Name);
{$ENDIF} {$ENDIF} }
end; end;
function TMFonts.LoadSystemFont(const SysFont: TFont; const FontName: string): boolean; function TMFonts.LoadSystemFont(const SysFont: TFont; const FontName: string): boolean;

View File

@ -118,6 +118,9 @@ type
n: String; // DOEN n: String; // DOEN
end; end;
PpDTM = ^pDTM;
{ Other DTM Types } { Other DTM Types }
TDTMPointDef = record TDTMPointDef = record

View File

@ -140,6 +140,9 @@ function TMOCR.InitTOCR(const path: string): boolean;
var var
dirs: array of string; dirs: array of string;
i: longint; i: longint;
{$IFDEF FONTDEBUG}
fonts_loaded: String = '';
{$ENDIF}
begin begin
// We're going to load all fonts now // We're going to load all fonts now
FFonts.Path := path; FFonts.Path := path;
@ -147,8 +150,21 @@ begin
Result := false; Result := false;
for i := 0 to high(dirs) do for i := 0 to high(dirs) do
begin 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 if FFonts.LoadFont(dirs[i], false) then
begin
fonts_loaded := fonts_loaded + dirs[i] + ', ';
result := true; 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; end;
If DirectoryExists(path + 'UpChars') then If DirectoryExists(path + 'UpChars') then
FFonts.LoadFont('UpChars', true); // shadow FFonts.LoadFont('UpChars', true); // shadow

View File

@ -49,6 +49,7 @@ begin
RegisterProperty('ClientHeight', 'Longint', iptRW); RegisterProperty('ClientHeight', 'Longint', iptRW);
RegisterProperty('ClientWidth', 'Longint', iptRW); RegisterProperty('ClientWidth', 'Longint', iptRW);
RegisterProperty('ShowHint', 'Boolean', iptRW); RegisterProperty('ShowHint', 'Boolean', iptRW);
RegisterProperty('Caption','STRING',iptRW);
RegisterProperty('Visible', 'Boolean', iptRW); RegisterProperty('Visible', 'Boolean', iptRW);
RegisterProperty('ENABLED', 'BOOLEAN', iptrw); RegisterProperty('ENABLED', 'BOOLEAN', iptrw);
RegisterProperty('CURSOR', 'TCURSOR', iptrw); RegisterProperty('CURSOR', 'TCURSOR', iptrw);

View File

@ -188,15 +188,19 @@ begin
with Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TPAGE') do with Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TPAGE') do
begin begin
RegisterProperty('CAPTION', 'String', iptrw); RegisterProperty('CAPTION', 'String', iptrw);
RegisterProperty('PageIndex','Integer',iptrw);
RegisterProperty('ONSHOW','TNotifyEvent',iptrw);
end; end;
end; end;
procedure SIRegisterTNOTEBOOK(Cl: TPSPascalCompiler); procedure SIRegisterTNOTEBOOK(Cl: TPSPascalCompiler);
begin begin
with Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TNOTEBOOK') do with Cl.AddClassN(cl.FindClass('TCUSTOMCONTROL'), 'TNOTEBOOK') do
begin begin
RegisterMethod('function TabIndexAtClientPos(ClientPos: TPoint): integer;');
RegisterProperty('ACTIVEPAGE', 'String', iptrw); RegisterProperty('ACTIVEPAGE', 'String', iptrw);
RegisterProperty('COLOR', 'TColor', iptrw); RegisterProperty('COLOR', 'TColor', iptrw);
RegisterProperty('FONT', 'TFont', iptrw); RegisterProperty('FONT', 'TFont', iptrw);
RegisterProperty('PAGECOUNT','INTEGER',iptr);
RegisterProperty('PAGEINDEX', 'INTEGER', iptrw); RegisterProperty('PAGEINDEX', 'INTEGER', iptrw);
RegisterProperty('PAGES', 'TSTRINGS', iptrw); RegisterProperty('PAGES', 'TSTRINGS', iptrw);
RegisterProperty('PARENTCOLOR', 'Boolean', iptrw); RegisterProperty('PARENTCOLOR', 'Boolean', iptrw);

View File

@ -476,6 +476,7 @@ begin
RegisterProperty('ITEMINDEX', 'INTEGER', iptrw); RegisterProperty('ITEMINDEX', 'INTEGER', iptrw);
RegisterProperty('SELCOUNT', 'INTEGER', iptr); RegisterProperty('SELCOUNT', 'INTEGER', iptr);
RegisterProperty('SELECTED', 'BOOLEAN INTEGER', iptrw); RegisterProperty('SELECTED', 'BOOLEAN INTEGER', iptrw);
RegisterProperty('ITEMHEIGHT','INTEGER',iptrw);
{$IFNDEF PS_MINIVCL} {$IFNDEF PS_MINIVCL}
RegisterMethod('procedure CLEAR'); RegisterMethod('procedure CLEAR');

View File

@ -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.

View File

@ -22,7 +22,8 @@ type
procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
procedure ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; procedure ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
end; end;
procedure SIRegister_Dialogs(CL: TPSPascalCompiler);
procedure RIRegister_Dialogs(CL: TPSRuntimeClassImporter);
implementation implementation
uses uses
@ -58,7 +59,7 @@ end;
procedure SIRegister_TPrintDialog(CL: TPSPascalCompiler); procedure SIRegister_TPrintDialog(CL: TPSPascalCompiler);
begin begin
//with RegClassS(CL,'TCommonDialog', 'TPrintDialog') do //with RegClassS(CL,'TCommonDialog', 'TPrintDialog') do
with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrintDialog') do { with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrintDialog') do
begin begin
RegisterProperty('Collate', 'Boolean', iptrw); RegisterProperty('Collate', 'Boolean', iptrw);
RegisterProperty('Copies', 'Integer', iptrw); RegisterProperty('Copies', 'Integer', iptrw);
@ -69,16 +70,16 @@ begin
RegisterProperty('PrintToFile', 'Boolean', iptrw); RegisterProperty('PrintToFile', 'Boolean', iptrw);
RegisterProperty('PrintRange', 'TPrintRange', iptrw); RegisterProperty('PrintRange', 'TPrintRange', iptrw);
RegisterProperty('ToPage', 'Integer', iptrw); RegisterProperty('ToPage', 'Integer', iptrw);
end; end; }
end; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure SIRegister_TPrinterSetupDialog(CL: TPSPascalCompiler); procedure SIRegister_TPrinterSetupDialog(CL: TPSPascalCompiler);
begin begin
//with RegClassS(CL,'TCommonDialog', 'TPrinterSetupDialog') do //with RegClassS(CL,'TCommonDialog', 'TPrinterSetupDialog') do
with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrinterSetupDialog') do { with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrinterSetupDialog') do
begin begin
end; end;}
end; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
@ -88,11 +89,11 @@ begin
with CL.AddClassN(CL.FindClass('TCommonDialog'),'TFontDialog') do with CL.AddClassN(CL.FindClass('TCommonDialog'),'TFontDialog') do
begin begin
RegisterProperty('Font', 'TFont', iptrw); RegisterProperty('Font', 'TFont', iptrw);
RegisterProperty('Device', 'TFontDialogDevice', iptrw); // RegisterProperty('Device', 'TFontDialogDevice', iptrw);
RegisterProperty('MinFontSize', 'Integer', iptrw); RegisterProperty('MinFontSize', 'Integer', iptrw);
RegisterProperty('MaxFontSize', 'Integer', iptrw); RegisterProperty('MaxFontSize', 'Integer', iptrw);
RegisterProperty('Options', 'TFontDialogOptions', iptrw); RegisterProperty('Options', 'TFontDialogOptions', iptrw);
RegisterProperty('OnApply', 'TFDApplyEvent', iptrw); // RegisterProperty('OnApply', 'TFDApplyEvent', iptrw);
end; end;
end; end;
@ -104,7 +105,7 @@ begin
begin begin
RegisterProperty('Color', 'TColor', iptrw); RegisterProperty('Color', 'TColor', iptrw);
RegisterProperty('CustomColors', 'TStrings', iptrw); RegisterProperty('CustomColors', 'TStrings', iptrw);
RegisterProperty('Options', 'TColorDialogOptions', iptrw); // RegisterProperty('Options', 'TColorDialogOptions', iptrw);
end; end;
end; end;
@ -127,7 +128,7 @@ begin
RegisterProperty('Files', 'TStrings', iptr); RegisterProperty('Files', 'TStrings', iptr);
RegisterProperty('HistoryList', 'TStrings', iptrw); RegisterProperty('HistoryList', 'TStrings', iptrw);
RegisterProperty('DefaultExt', 'string', iptrw); RegisterProperty('DefaultExt', 'string', iptrw);
RegisterProperty('FileName', 'TFileName', iptrw); RegisterProperty('FileName', 'String', iptrw);
RegisterProperty('Filter', 'string', iptrw); RegisterProperty('Filter', 'string', iptrw);
RegisterProperty('FilterIndex', 'Integer', iptrw); RegisterProperty('FilterIndex', 'Integer', iptrw);
RegisterProperty('InitialDir', 'string', iptrw); RegisterProperty('InitialDir', 'string', iptrw);
@ -137,7 +138,8 @@ begin
RegisterProperty('OnFolderChange', 'TNotifyEvent', iptrw); RegisterProperty('OnFolderChange', 'TNotifyEvent', iptrw);
RegisterProperty('OnSelectionChange', 'TNotifyEvent', iptrw); RegisterProperty('OnSelectionChange', 'TNotifyEvent', iptrw);
RegisterProperty('OnTypeChange', 'TNotifyEvent', iptrw); RegisterProperty('OnTypeChange', 'TNotifyEvent', iptrw);
RegisterProperty('OnIncludeItem', 'TIncludeItemEvent', iptrw); RegisterMethod('function Execute : boolean;');
// RegisterProperty('OnIncludeItem', 'TIncludeItemEvent', iptrw);
end; end;
end; end;
@ -148,7 +150,7 @@ begin
with CL.AddClassN(CL.FindClass('TComponent'),'TCommonDialog') do with CL.AddClassN(CL.FindClass('TComponent'),'TCommonDialog') do
begin begin
RegisterProperty('Handle', 'HWnd', iptr); RegisterProperty('Handle', 'HWnd', iptr);
RegisterProperty('Ctl3D', 'Boolean', iptrw); // RegisterProperty('Ctl3D', 'Boolean', iptrw);
RegisterProperty('HelpContext', 'THelpContext', iptrw); RegisterProperty('HelpContext', 'THelpContext', iptrw);
RegisterProperty('OnClose', 'TNotifyEvent', iptrw); RegisterProperty('OnClose', 'TNotifyEvent', iptrw);
RegisterProperty('OnShow', 'TNotifyEvent', iptrw); RegisterProperty('OnShow', 'TNotifyEvent', iptrw);
@ -168,21 +170,21 @@ begin
+'ng )'); +'ng )');
CL.AddTypeS('TOpenOptions', 'set of TOpenOption'); CL.AddTypeS('TOpenOptions', 'set of TOpenOption');
CL.AddTypeS('TFileEditStyle', '( fsEdit, fsComboBox )'); CL.AddTypeS('TFileEditStyle', '( fsEdit, fsComboBox )');
CL.AddTypeS('TIncludeItemEvent', 'Procedure ( const OFN : TOFNotifyEx; var In' // CL.AddTypeS('TIncludeItemEvent', 'Procedure ( const OFN : TOFNotifyEx; var In'
+'clude : Boolean)'); // +'clude : Boolean)');
SIRegister_TOpenDialog(CL); SIRegister_TOpenDialog(CL);
SIRegister_TSaveDialog(CL); SIRegister_TSaveDialog(CL);
CL.AddTypeS('TColorDialogOption', '( cdFullOpen, cdPreventFullOpen, cdShowHel' CL.AddTypeS('TColorDialogOption', '( cdFullOpen, cdPreventFullOpen, cdShowHel'
+'p, cdSolidColor, cdAnyColor )'); +'p, cdSolidColor, cdAnyColor )');
CL.AddTypeS('TColorDialogOptions', 'set of TColorDialogOption'); // CL.AddTypeS('TColorDialogOptions', 'set of TColorDialogOption');
SIRegister_TColorDialog(CL); SIRegister_TColorDialog(CL);
CL.AddTypeS('TFontDialogOption', '( fdAnsiOnly, fdTrueTypeOnly, fdEffects, fd' CL.AddTypeS('TFontDialogOption', '( fdAnsiOnly, fdTrueTypeOnly, fdEffects, fd'
+'FixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts, fdNoSimulatio' +'FixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts, fdNoSimulatio'
+'ns, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts, fdShowHelp, fdWysiwyg, fdL' +'ns, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts, fdShowHelp, fdWysiwyg, fdL'
+'imitSize, fdScalableOnly, fdApplyButton )'); +'imitSize, fdScalableOnly, fdApplyButton )');
CL.AddTypeS('TFontDialogOptions', 'set of TFontDialogOption'); CL.AddTypeS('TFontDialogOptions', 'set of TFontDialogOption');
CL.AddTypeS('TFontDialogDevice', '( fdScreen, fdPrinter, fdBoth )'); // CL.AddTypeS('TFontDialogDevice', '( fdScreen, fdPrinter, fdBoth )');
CL.AddTypeS('TFDApplyEvent', 'Procedure ( Sender : TObject; Wnd : HWND)'); // CL.AddTypeS('TFDApplyEvent', 'Procedure ( Sender : TObject; Wnd : HWND)');
SIRegister_TFontDialog(CL); SIRegister_TFontDialog(CL);
SIRegister_TPrinterSetupDialog(CL); SIRegister_TPrinterSetupDialog(CL);
CL.AddTypeS('TPrintRange', '( prAllPages, prSelection, prPageNums )'); CL.AddTypeS('TPrintRange', '( prAllPages, prSelection, prPageNums )');
@ -201,17 +203,17 @@ begin
CL.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m' CL.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m'
+'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )'); +'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )');
CL.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn'); CL.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn');
CL.AddConstantN('mbYesNoCancel','LongInt').Value.ts32 := ord(mbYes) or ord(mbNo) or ord(mbCancel); CL.AddConstantN('mbYesNoCancel','LongInt').SetInt(ord(mbYes) or ord(mbNo) or ord(mbCancel));
CL.AddConstantN('mbOKCancel','LongInt').Value.ts32 := ord(mbOK) or ord(mbCancel); CL.AddConstantN('mbOKCancel','LongInt').SetInt(ord(mbOK) or ord(mbCancel));
CL.AddConstantN('mbAbortRetryIgnore','LongInt').Value.ts32 := ord(mbAbort) or ord(mbRetry) or ord(mbIgnore); 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 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 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 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('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 ShowMessage( const Msg : string)');
CL.AddDelphiFunction('Procedure ShowMessagePos( const Msg : string; X, Y : Integer)'); CL.AddDelphiFunction('Procedure ShowMessagePos( const Msg : string; X, Y : Integer)');
CL.AddDelphiFunction('Function InputBox( const ACaption, APrompt, ADefault : string) : string'); 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; end;
(* === run-time registration functions === *) (* === run-time registration functions === *)
@ -263,7 +265,7 @@ begin Self.Left := T; end;
procedure TFindDialogLeft_R(Self: TFindDialog; var T: Integer); procedure TFindDialogLeft_R(Self: TFindDialog; var T: Integer);
begin T := Self.Left; end; begin T := Self.Left; end;
(*----------------------------------------------------------------------------*) {(*----------------------------------------------------------------------------*)
procedure TPrintDialogToPage_W(Self: TPrintDialog; const T: Integer); procedure TPrintDialogToPage_W(Self: TPrintDialog; const T: Integer);
begin Self.ToPage := T; end; begin Self.ToPage := T; end;
@ -333,15 +335,15 @@ begin Self.Collate := T; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure TPrintDialogCollate_R(Self: TPrintDialog; var T: Boolean); 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); procedure TFontDialogOnApply_W(Self: TFontDialog; const T: TFDApplyEvent);
begin Self.OnApply := T; end; begin Self.OnApply := T; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure TFontDialogOnApply_R(Self: TFontDialog; var T: TFDApplyEvent); 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); 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); procedure TFontDialogMinFontSize_R(Self: TFontDialog; var T: Integer);
begin T := Self.MinFontSize; end; begin T := Self.MinFontSize; end;
(*----------------------------------------------------------------------------*) {(*----------------------------------------------------------------------------*)
procedure TFontDialogDevice_W(Self: TFontDialog; const T: TFontDialogDevice); procedure TFontDialogDevice_W(Self: TFontDialog; const T: TFontDialogDevice);
begin Self.Device := T; end; begin Self.Device := T; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure TFontDialogDevice_R(Self: TFontDialog; var T: TFontDialogDevice); 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); 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; 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; begin Self.Options := T; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure TColorDialogOptions_R(Self: TColorDialog; var T: TColorDialogOptions); 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); 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); procedure TColorDialogColor_R(Self: TColorDialog; var T: TColor);
begin T := Self.Color; end; begin T := Self.Color; end;
(*----------------------------------------------------------------------------*) {(*----------------------------------------------------------------------------*)
procedure TOpenDialogOnIncludeItem_W(Self: TOpenDialog; const T: TIncludeItemEvent); procedure TOpenDialogOnIncludeItem_W(Self: TOpenDialog; const T: TIncludeItemEvent);
begin Self.OnIncludeItem := T; end; begin Self.OnIncludeItem := T; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure TOpenDialogOnIncludeItem_R(Self: TOpenDialog; var T: TIncludeItemEvent); 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); 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); procedure TOpenDialogFiles_R(Self: TOpenDialog; var T: TStrings);
begin T := Self.Files; end; begin T := Self.Files; end;
(*----------------------------------------------------------------------------*) {(*----------------------------------------------------------------------------*)
procedure TOpenDialogFileEditStyle_W(Self: TOpenDialog; const T: TFileEditStyle); procedure TOpenDialogFileEditStyle_W(Self: TOpenDialog; const T: TFileEditStyle);
begin Self.FileEditStyle := T; end; begin Self.FileEditStyle := T; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure TOpenDialogFileEditStyle_R(Self: TOpenDialog; var T: TFileEditStyle); 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); 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); procedure TCommonDialogHelpContext_R(Self: TCommonDialog; var T: THelpContext);
begin T := Self.HelpContext; end; begin T := Self.HelpContext; end;
(*----------------------------------------------------------------------------*) {(*----------------------------------------------------------------------------*)
procedure TCommonDialogCtl3D_W(Self: TCommonDialog; const T: Boolean); procedure TCommonDialogCtl3D_W(Self: TCommonDialog; const T: Boolean);
begin Self.Ctl3D := T; end; begin Self.Ctl3D := T; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure TCommonDialogCtl3D_R(Self: TCommonDialog; var T: Boolean); 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); procedure TCommonDialogHandle_R(Self: TCommonDialog; var T: HWnd);
@ -598,7 +600,7 @@ end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure RIRegister_TPrintDialog(CL: TPSRuntimeClassImporter); procedure RIRegister_TPrintDialog(CL: TPSRuntimeClassImporter);
begin begin
with CL.Add(TPrintDialog) do { with CL.Add(TPrintDialog) do
begin begin
RegisterPropertyHelper(@TPrintDialogCollate_R,@TPrintDialogCollate_W,'Collate'); RegisterPropertyHelper(@TPrintDialogCollate_R,@TPrintDialogCollate_W,'Collate');
RegisterPropertyHelper(@TPrintDialogCopies_R,@TPrintDialogCopies_W,'Copies'); RegisterPropertyHelper(@TPrintDialogCopies_R,@TPrintDialogCopies_W,'Copies');
@ -609,15 +611,15 @@ begin
RegisterPropertyHelper(@TPrintDialogPrintToFile_R,@TPrintDialogPrintToFile_W,'PrintToFile'); RegisterPropertyHelper(@TPrintDialogPrintToFile_R,@TPrintDialogPrintToFile_W,'PrintToFile');
RegisterPropertyHelper(@TPrintDialogPrintRange_R,@TPrintDialogPrintRange_W,'PrintRange'); RegisterPropertyHelper(@TPrintDialogPrintRange_R,@TPrintDialogPrintRange_W,'PrintRange');
RegisterPropertyHelper(@TPrintDialogToPage_R,@TPrintDialogToPage_W,'ToPage'); RegisterPropertyHelper(@TPrintDialogToPage_R,@TPrintDialogToPage_W,'ToPage');
end; end; }
end; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure RIRegister_TPrinterSetupDialog(CL: TPSRuntimeClassImporter); procedure RIRegister_TPrinterSetupDialog(CL: TPSRuntimeClassImporter);
begin begin
with CL.Add(TPrinterSetupDialog) do { with CL.Add(TPrinterSetupDialog) do
begin begin
end; end;}
end; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
@ -626,11 +628,11 @@ begin
with CL.Add(TFontDialog) do with CL.Add(TFontDialog) do
begin begin
RegisterPropertyHelper(@TFontDialogFont_R,@TFontDialogFont_W,'Font'); 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(@TFontDialogMinFontSize_R,@TFontDialogMinFontSize_W,'MinFontSize');
RegisterPropertyHelper(@TFontDialogMaxFontSize_R,@TFontDialogMaxFontSize_W,'MaxFontSize'); RegisterPropertyHelper(@TFontDialogMaxFontSize_R,@TFontDialogMaxFontSize_W,'MaxFontSize');
RegisterPropertyHelper(@TFontDialogOptions_R,@TFontDialogOptions_W,'Options'); RegisterPropertyHelper(@TFontDialogOptions_R,@TFontDialogOptions_W,'Options');
RegisterPropertyHelper(@TFontDialogOnApply_R,@TFontDialogOnApply_W,'OnApply'); // RegisterPropertyHelper(@TFontDialogOnApply_R,@TFontDialogOnApply_W,'OnApply');
end; end;
end; end;
@ -641,7 +643,7 @@ begin
begin begin
RegisterPropertyHelper(@TColorDialogColor_R,@TColorDialogColor_W,'Color'); RegisterPropertyHelper(@TColorDialogColor_R,@TColorDialogColor_W,'Color');
RegisterPropertyHelper(@TColorDialogCustomColors_R,@TColorDialogCustomColors_W,'CustomColors'); RegisterPropertyHelper(@TColorDialogCustomColors_R,@TColorDialogCustomColors_W,'CustomColors');
RegisterPropertyHelper(@TColorDialogOptions_R,@TColorDialogOptions_W,'Options'); // RegisterPropertyHelper(@TColorDialogOptions_R,@TColorDialogOptions_W,'Options');
end; end;
end; end;
@ -658,7 +660,7 @@ procedure RIRegister_TOpenDialog(CL: TPSRuntimeClassImporter);
begin begin
with CL.Add(TOpenDialog) do with CL.Add(TOpenDialog) do
begin begin
RegisterPropertyHelper(@TOpenDialogFileEditStyle_R,@TOpenDialogFileEditStyle_W,'FileEditStyle'); // RegisterPropertyHelper(@TOpenDialogFileEditStyle_R,@TOpenDialogFileEditStyle_W,'FileEditStyle');
RegisterPropertyHelper(@TOpenDialogFiles_R,nil,'Files'); RegisterPropertyHelper(@TOpenDialogFiles_R,nil,'Files');
RegisterPropertyHelper(@TOpenDialogHistoryList_R,@TOpenDialogHistoryList_W,'HistoryList'); RegisterPropertyHelper(@TOpenDialogHistoryList_R,@TOpenDialogHistoryList_W,'HistoryList');
RegisterPropertyHelper(@TOpenDialogDefaultExt_R,@TOpenDialogDefaultExt_W,'DefaultExt'); RegisterPropertyHelper(@TOpenDialogDefaultExt_R,@TOpenDialogDefaultExt_W,'DefaultExt');
@ -672,7 +674,8 @@ begin
RegisterPropertyHelper(@TOpenDialogOnFolderChange_R,@TOpenDialogOnFolderChange_W,'OnFolderChange'); RegisterPropertyHelper(@TOpenDialogOnFolderChange_R,@TOpenDialogOnFolderChange_W,'OnFolderChange');
RegisterPropertyHelper(@TOpenDialogOnSelectionChange_R,@TOpenDialogOnSelectionChange_W,'OnSelectionChange'); RegisterPropertyHelper(@TOpenDialogOnSelectionChange_R,@TOpenDialogOnSelectionChange_W,'OnSelectionChange');
RegisterPropertyHelper(@TOpenDialogOnTypeChange_R,@TOpenDialogOnTypeChange_W,'OnTypeChange'); RegisterPropertyHelper(@TOpenDialogOnTypeChange_R,@TOpenDialogOnTypeChange_W,'OnTypeChange');
RegisterPropertyHelper(@TOpenDialogOnIncludeItem_R,@TOpenDialogOnIncludeItem_W,'OnIncludeItem'); RegisterMethod(@TOpenDialog.execute,'EXECUTE');
// RegisterPropertyHelper(@TOpenDialogOnIncludeItem_R,@TOpenDialogOnIncludeItem_W,'OnIncludeItem');
end; end;
end; end;
@ -682,7 +685,7 @@ begin
with CL.Add(TCommonDialog) do with CL.Add(TCommonDialog) do
begin begin
RegisterPropertyHelper(@TCommonDialogHandle_R,nil,'Handle'); RegisterPropertyHelper(@TCommonDialogHandle_R,nil,'Handle');
RegisterPropertyHelper(@TCommonDialogCtl3D_R,@TCommonDialogCtl3D_W,'Ctl3D'); // RegisterPropertyHelper(@TCommonDialogCtl3D_R,@TCommonDialogCtl3D_W,'Ctl3D');
RegisterPropertyHelper(@TCommonDialogHelpContext_R,@TCommonDialogHelpContext_W,'HelpContext'); RegisterPropertyHelper(@TCommonDialogHelpContext_R,@TCommonDialogHelpContext_W,'HelpContext');
RegisterPropertyHelper(@TCommonDialogOnClose_R,@TCommonDialogOnClose_W,'OnClose'); RegisterPropertyHelper(@TCommonDialogOnClose_R,@TCommonDialogOnClose_W,'OnClose');
RegisterPropertyHelper(@TCommonDialogOnShow_R,@TCommonDialogOnShow_W,'OnShow'); RegisterPropertyHelper(@TCommonDialogOnShow_R,@TCommonDialogOnShow_W,'OnShow');

View File

@ -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 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_W(Self: TCONTROL; T: BOOLEAN); begin Self.ENABLED := T; end;
procedure TCONTROLENABLED_R(Self: TCONTROL; var T: BOOLEAN); begin T := Self.ENABLED; 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); procedure RIRegisterTControl(Cl: TPSRuntimeClassImporter);
begin begin
@ -71,7 +74,7 @@ begin
RegisterPropertyHelper(@TControlClientWidthR, @TControlClientWidthW, 'CLIENTWIDTH'); RegisterPropertyHelper(@TControlClientWidthR, @TControlClientWidthW, 'CLIENTWIDTH');
RegisterPropertyHelper(@TControlVisibleR, @TControlVisibleW, 'VISIBLE'); RegisterPropertyHelper(@TControlVisibleR, @TControlVisibleW, 'VISIBLE');
RegisterPropertyHelper(@TCONTROLENABLED_R, @TCONTROLENABLED_W, 'ENABLED'); RegisterPropertyHelper(@TCONTROLENABLED_R, @TCONTROLENABLED_W, 'ENABLED');
RegisterPropertyHelper(@TControlCaption_R,@TControlCaption_W,'CAPTION');
RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT'); RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT');
{$IFNDEF PS_MINIVCL} {$IFNDEF PS_MINIVCL}
@ -79,8 +82,8 @@ begin
RegisterMethod(@TControl.HasParent, 'HASPARENT'); RegisterMethod(@TControl.HasParent, 'HASPARENT');
RegisterMethod(@TCONTROL.CLIENTTOSCREEN, 'CLIENTTOSCREEN'); RegisterMethod(@TCONTROL.CLIENTTOSCREEN, 'CLIENTTOSCREEN');
RegisterMethod(@TCONTROL.DRAGGING, 'DRAGGING'); RegisterMethod(@TCONTROL.DRAGGING, 'DRAGGING');
RegisterMethod(@TControlBeginDrag, 'BEGINDRAG');
{$IFNDEF FPC} {$IFNDEF FPC}
RegisterMethod(@TCONTROL.BEGINDRAG, 'BEGINDRAG');
RegisterMethod(@TCONTROL.ENDDRAG, 'ENDDRAG'); RegisterMethod(@TCONTROL.ENDDRAG, 'ENDDRAG');
{$ENDIF} {$ENDIF}
{$IFNDEF CLX} {$IFNDEF CLX}

View File

@ -30,7 +30,7 @@ uses
{$IFDEF CLX} {$IFDEF CLX}
QExtCtrls, QGraphics; QExtCtrls, QGraphics;
{$ELSE} {$ELSE}
ExtCtrls, Graphics; ExtCtrls, Graphics,classes;
{$ENDIF} {$ENDIF}
procedure RIRegisterTSHAPE(Cl: TPSRuntimeClassImporter); procedure RIRegisterTSHAPE(Cl: TPSRuntimeClassImporter);
@ -82,15 +82,28 @@ procedure RIRegisterTPANEL(Cl: TPSRuntimeClassImporter);
begin begin
Cl.Add(TPANEL); Cl.Add(TPANEL);
end; 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} {$IFNDEF CLX}
procedure RIRegisterTPAGE(Cl: TPSRuntimeClassImporter); procedure RIRegisterTPAGE(Cl: TPSRuntimeClassImporter);
begin begin
Cl.Add(TPAGE); with Cl.Add(TPAGE) do
begin
RegisterPropertyHelper(@TPagePageIndex_R,@TPagePageIndex_W,'PageIndex');
RegisterEventPropertyHelper(@TPageOnShow_R,@TPageOnShow_W,'OnShow');
end;
end; end;
procedure TNoteBookPageCount_R(Self: TNoteBook; var T: INTEGER); begin T := Self.PageCount; end;
procedure RIRegisterTNOTEBOOK(Cl: TPSRuntimeClassImporter); procedure RIRegisterTNOTEBOOK(Cl: TPSRuntimeClassImporter);
begin begin
Cl.Add(TNOTEBOOK); with Cl.Add(TNOTEBOOK) do
begin
RegisterMethod(@TNoteBook.TabIndexAtClientPos,'TABINDEXATCLIENTPOS');
RegisterPropertyHelper(@TNoteBookPageCount_R,nil,'PAGECOUNT');
end;
end; end;
{$IFNDEF FPC} {$IFNDEF FPC}

View File

@ -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 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_R(Self: TCUSTOMLISTBOX; var T: INTEGER); begin T := Self.TOPINDEX; end;
procedure TCUSTOMLISTBOXTOPINDEX_W(Self: TCUSTOMLISTBOX; T: INTEGER); begin Self.TOPINDEX := T; 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); procedure RIRegisterTCUSTOMLISTBOX(Cl: TPSRuntimeClassImporter);
begin begin
@ -227,6 +228,7 @@ begin
RegisterPropertyHelper(@TCUSTOMLISTBOXITEMINDEX_R, @TCUSTOMLISTBOXITEMINDEX_W, 'ITEMINDEX'); RegisterPropertyHelper(@TCUSTOMLISTBOXITEMINDEX_R, @TCUSTOMLISTBOXITEMINDEX_W, 'ITEMINDEX');
RegisterPropertyHelper(@TCUSTOMLISTBOXSELCOUNT_R, nil, 'SELCOUNT'); RegisterPropertyHelper(@TCUSTOMLISTBOXSELCOUNT_R, nil, 'SELCOUNT');
RegisterPropertyHelper(@TCUSTOMLISTBOXSELECTED_R, @TCUSTOMLISTBOXSELECTED_W, 'SELECTED'); RegisterPropertyHelper(@TCUSTOMLISTBOXSELECTED_R, @TCUSTOMLISTBOXSELECTED_W, 'SELECTED');
RegisterPropertyHelper(@TCUSTOMLISTBOXITEMHEIGHT_R,@TCUSTOMLISTBOXITEMHEIGHT_W,'ITEMHEIGHT');
{$IFNDEF PS_MINIVCL} {$IFNDEF PS_MINIVCL}
RegisterMethod(@TCUSTOMLISTBOX.CLEAR, 'CLEAR'); RegisterMethod(@TCUSTOMLISTBOX.CLEAR, 'CLEAR');