moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-25 08:48:51 -05:00
Code Issues Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

2
Install/windows/Setup.iss
View File

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

6
Projects/SAMufasaGUI/debugimage.lfm
View File

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

111
Projects/SAMufasaGUI/testunit.lfm
View File

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

17
Projects/SAMufasaGUI/testunit.pas
View File

@ -46,7 +46,7 @@ uses
CastaliaSimplePasPar, v_AutoCompleteForm, PSDump;
const
SimbaVersion = 637;
SimbaVersion = 650;
type
@ -248,6 +248,7 @@ type
procedure ChangeMouseStatus(Sender: TObject);
procedure CheckBoxMatchCaseClick(Sender: TObject);
procedure CloseFindPanel;
procedure doOnHide(Sender: TObject);
procedure editSearchListExit(Sender: TObject);
procedure editSearchListKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
@ -1389,8 +1390,8 @@ begin
FormWritelnEx('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now');
Thread.SetPaths(ScriptPath,AppPath,Includepath,PluginPath,fontPath);
if selector.haspicked then Thread.Client.IOManager.SetTarget(Selector.LastPick);
if selector.haspicked then
Thread.Client.IOManager.SetTarget(Selector.LastPick);
loadFontsOnScriptStart := (lowercase(LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True')) = 'true');
// Copy our current fonts
@ -1715,6 +1716,16 @@ begin
CurrScript.SynEdit.SetFocus;
end;
{
If we are being sent to the background; then minimize other active windows as
well.
}
procedure TForm1.doOnHide(Sender: TObject);
begin
if DebugImgForm.Visible then
DebugImgForm.Hide;
end;
procedure TForm1.StopCodeCompletion;
begin
CodeCompletionForm.Hide;

17
Units/MMLAddon/PSInc/Wrappers/bitmap.inc
View File

@ -105,6 +105,11 @@ begin;
result := CurrThread.Client.MBitmaps[Bmp].FastGetPixels(TPA);
end;
function ps_GetBitmapAreaColors(bmp,xs, ys, xe, ye: Integer): T2DIntArray;extdecl;
begin
result := CurrThread.Client.MBitmaps[bmp].GetAreaColors(xs,ys,xe,ye);
end;
procedure ps_FastSetPixel(Bmp,x,y : integer; Color : TColor); extdecl;
begin
CurrThread.Client.MBitmaps[bmp].FastSetPixel(x,y,color);
@ -299,3 +304,15 @@ procedure ps_FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const
begin
CurrThread.Client.MBitmaps[bitmap].FloodFill(startPoint,searchcol,replacecol);
end;
function ps_CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer;extdecl;
begin
with CurrThread.Client.MBitmaps do
result := CalculatePixelShift(GetBMP(bmp1),GetBMP(bmp2),comparebox);
end;
function ps_CalculatePixelTolerance(Bmp1,Bmp2 : Integer; CompareBox : TBox; CTS : integer) : extended;extdecl;
begin
with CurrThread.Client.MBitmaps do
result := CalculatePixelTolerance(GetBMP(bmp1),GetBMP(bmp2),comparebox,cts);
end;

5
Units/MMLAddon/PSInc/Wrappers/file.inc
View File

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

10
Units/MMLAddon/PSInc/Wrappers/math.inc
View File

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

12
Units/MMLAddon/PSInc/Wrappers/ocr.inc
View File

@ -52,3 +52,15 @@ function ps_LoadSystemFont(const SysFont : TFont; const FontName : string) : boo
begin
result := CurrThread.Client.MOCR.Fonts.LoadSystemFont(SysFont,FontName);
end;
function ps_LoadFont(const FontName: string; shadow: boolean): boolean; extdecl;
begin
result := CurrThread.Client.MOCR.Fonts.LoadFont(FontName, shadow);
end;
function ps_FreeFont(const FontName: string): boolean; extdecl;
begin
result := CurrThread.Client.MOCR.Fonts.FreeFont(FontName);
end;

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

@ -163,3 +163,13 @@ function ps_Random(Int: integer): integer; extdecl;
begin
result := Random(int);
end;
function ps_InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;extdecl;
begin
CurrThread.InputQueryData.ACaption:= ACaption;
CurrThread.InputQueryData.APrompt:= APrompt;
CurrThread.InputQueryData.Value:= Value;
CurrThread.Synchronize(@CurrThread.mInputQuery);
Value := CurrThread.InputQueryData.Value;
result := CurrThread.InputQueryData.Res;
end;

11
Units/MMLAddon/PSInc/psexportedmethods.inc
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_logn,'function logn(base, x : extended): extended;');
AddFunction(@ps_ln,'function ln(x : extended) : extended;');
AddFunction(@ps_inttohex,'function IntToHex(number : integer) : string');
AddFunction(@ps_hextoint,'function HexToInt(Hex : string) : integer');
{window}
SetCurrSection('Window');
@ -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_ReadINI,'function ReadINI(const Section, KeyName, FileName: string): string;');
AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName: string);');
AddFunction(@ps_ExtractFileExt,'function ExtractFileExt(const FileName: string): string;');
{other}
SetCurrSection('Other');
@ -135,8 +138,7 @@ AddFunction(@ps_PlaySound,'procedure PlaySound( Sound : string);');
AddFunction(@ps_StopSound,'procedure StopSound;');
AddFunction(@ps_SetScriptProp, 'function SetScriptProp(Prop : TSP_Property; Value: TVariantArray): boolean;');
AddFunction(@ps_GetScriptProp, 'function GetScriptProp(Prop : TSP_Property;var Value: TVariantArray): boolean;');
AddFunction(@ps_InputQuery,'function InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;');
{string}
SetCurrSection('String');
@ -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_gettextATPA,'function GetTextATPA(const ATPA : T2DPointArray; const maxvspacing : integer; const font : string): string;');
AddFunction(@ps_LoadSystemFont,'function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;');
AddFunction(@ps_LoadFont, 'function LoadFont(const FontName: string; shadow: boolean): boolean;');
AddFunction(@ps_FreeFont, 'function FreeFont(const FontName: string): boolean;');
{Bitmaps}
SetCurrSection('Bitmaps');
@ -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_FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
AddFunction(@ps_FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
AddFunction(@ps_GetBitmapAreaColors,'function GetBitmapAreaColors(bmp,xs, ys, xe, ye: Integer): T2DIntegerArray;');
AddFunction(@ps_FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor);');
AddFunction(@ps_FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
AddFunction(@ps_SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
@ -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_RectangleBitmap,'procedure RectangleBitmap(bitmap : integer; const box : TBox; Color : TColor);');
AddFunction(@ps_FloodfillBitmap,'procedure FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const SearchCol,ReplaceCol : TColor);');
AddFunction(@ps_CalculatePixelShift,'function CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer;');
AddFunction(@ps_CalculatePixelTolerance,'function CalculatePixelTolerance(Bmp1,Bmp2 : Integer; CompareBox : TBox; CTS : integer) : extended;');
{tpa}
SetCurrSection('TPA');

20
Units/MMLAddon/mmlpsthread.pas
View File

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

1
Units/MMLAddon/scriptproperties.pas
View File

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

88
Units/MMLCore/bitmaps.pas
View File

@ -63,6 +63,7 @@ type
function CreateTPA(SearchCol : TColor) : TPointArray;
function FastGetPixel(x,y : integer) : TColor;
function FastGetPixels(Points : TPointArray) : TIntegerArray;
function GetAreaColors(xs,ys,xe,ye : integer) : T2DIntArray;
procedure FastDrawClear(Color : TColor);
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
procedure FastReplaceColor(OldColor, NewColor: TColor);
@ -91,6 +92,7 @@ type
procedure SetTransparentColor(Col : TColor);
function GetTransparentColor : TColor;
property TransparentColorSet : boolean read FTransparentSet;
procedure SetAlphaValue(const value : byte);
constructor Create;
destructor Destroy;override;
end;
@ -120,7 +122,8 @@ type
end;
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
function CalculatePixelShift(Bmp1,Bmp2 : TMufasaBitmap; CompareBox : TBox) : integer;
function CalculatePixelTolerance(Bmp1,Bmp2 : TMufasaBitmap; CompareBox : TBox; CTS : integer) : extended;
implementation
uses
@ -162,6 +165,68 @@ Begin
RawImage.Data := PByte(Ptr);
End;
function CalculatePixelShift(Bmp1, Bmp2: TMufasaBitmap; CompareBox: TBox): integer;
var
x,y : integer;
w1,w2 : integer;
begin
Bmp1.ValidatePoint(comparebox.x1,comparebox.y1);
Bmp1.ValidatePoint(comparebox.x2,comparebox.y2);
Bmp2.ValidatePoint(comparebox.x1,comparebox.y1);
Bmp2.ValidatePoint(comparebox.x1,comparebox.y1);
Bmp1.SetAlphaValue(0);
Bmp2.SetAlphaValue(0);
w1 := bmp1.Width;
w2 := bmp2.width;
result := 0;
for y := CompareBox.y1 to CompareBox.y2 do
for x := CompareBox.x1 to CompareBox.x2 do
if LongWord(Bmp1.FData[y * w1 + x]) <> LongWord(Bmp2.Fdata[y * w2 + x]) then
inc(result);
end;
//CTS 0 counts the average difference in R,G,B per pixel
//CTS 1 counts the average difference using SQRT(Sqr(r) + sqr(g)+sqr(b));
function CalculatePixelTolerance(Bmp1, Bmp2: TMufasaBitmap; CompareBox: TBox;
CTS: integer): extended;
var
x,y : integer;
w1,w2 : integer;
Diff : int64;
begin
Bmp1.ValidatePoint(comparebox.x1,comparebox.y1);
Bmp1.ValidatePoint(comparebox.x2,comparebox.y2);
Bmp2.ValidatePoint(comparebox.x1,comparebox.y1);
Bmp2.ValidatePoint(comparebox.x1,comparebox.y1);
Bmp1.SetAlphaValue(0);
Bmp2.SetAlphaValue(0);
w1 := bmp1.Width;
w2 := bmp2.width;
result := 0;
if not InRange(CTS,0,1) then
raise exception.CreateFmt('CTS Passed to CalculateTolerance must be in [0..1], it currently is %d',[CTS]);
case CTS of
0 : begin
Diff := 0;
for y := CompareBox.y1 to CompareBox.y2 do
for x := CompareBox.x1 to CompareBox.x2 do
begin
Diff := Diff + abs(Bmp1.FData[y * w1 + x].r-Bmp2.Fdata[y * w2 + x].r) +
abs(Bmp1.FData[y * w1 + x].g-Bmp2.Fdata[y * w2 + x].g) +
abs(Bmp1.FData[y * w1 + x].b-Bmp2.Fdata[y * w2 + x].b);
end;
Result := Diff / (3 * (CompareBox.x2 - CompareBox.x1 + 1) * (CompareBox.y2-CompareBox.y1 + 1)); //We want the value for the whole Pixel; so divide by 3 (RGB)
end;
1 : begin
for y := CompareBox.y1 to CompareBox.y2 do
for x := CompareBox.x1 to CompareBox.x2 do
Result := Result + Sqrt(Sqr(Bmp1.FData[y * w1 + x].r-Bmp2.Fdata[y * w2 + x].r) +
Sqr(Bmp1.FData[y * w1 + x].g-Bmp2.Fdata[y * w2 + x].g) +
Sqr(Bmp1.FData[y * w1 + x].b-Bmp2.Fdata[y * w2 + x].b));
Result := Result / ((CompareBox.x2 - CompareBox.x1 + 1) * (CompareBox.y2-CompareBox.y1 + 1)); //We want the value for the whole Pixel;
end;
end;
end;
function Min(a,b:integer) : integer;
begin
if a < b then
@ -491,6 +556,7 @@ begin
ValidatePoint(StartPT.x,StartPT.y);
Search := LongWord(RGBToBGR(SearchCol));
Replace := LongWord(RGBToBGR(ReplaceCol));
SetAlphaValue(0);
if LongWord(FData[StartPT.y * w + StartPT.x]) <> Search then //Only add items to the stack that are the searchcol.
Exit;
SetLength(Stack,w * h);
@ -781,6 +847,18 @@ begin
Result[i] := BGRToRGB(FData[Points[i].y*w + Points[i].x]);
end;
function TMufasaBitmap.GetAreaColors(xs, ys, xe, ye : integer): T2DIntArray;
var
x,y : integer;
begin
ValidatePoint(xs,ys);
ValidatePoint(xe,ye);
setlength(result,xe-xs+1,ye-ys+1);
for x := xs to xe do
for y := ys to ye do
result[x-xs][y-ys] := BGRToRGB(FData[y*w+x]);
end;
procedure TMufasaBitmap.SetTransparentColor(Col: TColor);
begin
self.FTransparentSet:= True;
@ -795,6 +873,14 @@ begin
raise Exception.CreateFmt('Transparent color for Bitmap[%d] isn''t set',[index]);
end;
procedure TMufasaBitmap.SetAlphaValue(const value: byte);
var
i : integer;
begin
for i := w * h - 1 downto 0 do
FData[i].A:= Value;
end;
procedure TMufasaBitmap.FastDrawClear(Color: TColor);
var
i : integer;

43
Units/MMLCore/dtm.pas
View File

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

4
Units/MMLCore/fontloader.pas
View File

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

3
Units/MMLCore/mufasatypes.pas
View File

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

16
Units/MMLCore/ocr.pas
View File

@ -140,6 +140,9 @@ function TMOCR.InitTOCR(const path: string): boolean;
var
dirs: array of string;
i: longint;
{$IFDEF FONTDEBUG}
fonts_loaded: String = '';
{$ENDIF}
begin
// We're going to load all fonts now
FFonts.Path := path;
@ -147,8 +150,21 @@ begin
Result := false;
for i := 0 to high(dirs) do
begin
{$IFDEF FONTDEBUG}
// REMOVING THIS WILL CAUSE FONTS_LOADED NOT BE ADDED SOMEHOW?
writeln('Loading: ' + dirs[i]);
{$ENDIF}
if FFonts.LoadFont(dirs[i], false) then
begin
fonts_loaded := fonts_loaded + dirs[i] + ', ';
result := true;
end;
end;
if length(fonts_loaded) > 2 then
begin
writeln(fonts_loaded);
setlength(fonts_loaded,length(fonts_loaded)-2);
TClient(Self.Client).WriteLn('Loaded fonts: ' + fonts_loaded);
end;
If DirectoryExists(path + 'UpChars') then
FFonts.LoadFont('UpChars', true); // shadow

1
Units/PascalScript/uPSC_controls.pas
View File

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

4
Units/PascalScript/uPSC_extctrls.pas
View File

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

1
Units/PascalScript/uPSC_stdctrls.pas
View File

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

838
Units/PascalScript/uPSI_ComCtrls.pas Normal file
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.

93
Units/PascalScript/uPSI_Dialogs.pas
View File

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

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

19
Units/PascalScript/uPSR_extctrls.pas
View File

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

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