david
111d889bc6
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@32 05c56307-c608-d34a-929d-697000501d7a
191 lines
8.4 KiB
ObjectPascal
191 lines
8.4 KiB
ObjectPascal
unit ifpii_controls;
|
|
{$I ifps3_def.inc}
|
|
interface
|
|
uses
|
|
ifpscomp, ifps3common, ifps3utl, ifpiclass;
|
|
{
|
|
Will register files from:
|
|
Controls
|
|
|
|
Register the STD, Classes (at least the types&consts) and Graphics libraries first
|
|
|
|
}
|
|
|
|
procedure SIRegister_Controls_TypesAndConsts(Cl: TIFPSCompileTimeClassesImporter);
|
|
|
|
procedure SIRegisterTControl(Cl: TIFPSCompileTimeClassesImporter);
|
|
procedure SIRegisterTWinControl(Cl: TIFPSCompileTimeClassesImporter); // requires TControl
|
|
procedure SIRegisterTGraphicControl(cl: TIFPSCompileTimeClassesImporter); // requires TControl
|
|
procedure SIRegisterTCustomControl(cl: TIFPSCompileTimeClassesImporter); // requires TWinControl
|
|
|
|
|
|
procedure SIRegister_Controls(Cl: TIFPSCompileTimeClassesImporter);
|
|
|
|
|
|
implementation
|
|
|
|
procedure SIRegisterTControl(Cl: TIFPSCompileTimeClassesImporter);
|
|
begin
|
|
with Cl.Add2(cl.FindClass('TComponent'), 'TCONTROL') do
|
|
begin
|
|
RegisterMethod('constructor Create(AOwner: TComponent);');
|
|
RegisterMethod('procedure BringToFront;');
|
|
RegisterMethod('procedure Hide;');
|
|
RegisterMethod('procedure Invalidate;virtual;');
|
|
RegisterMethod('procedure refresh;');
|
|
RegisterMethod('procedure Repaint;virtual;');
|
|
RegisterMethod('procedure SendToBack;');
|
|
RegisterMethod('procedure Show;');
|
|
RegisterMethod('procedure Update;');
|
|
RegisterMethod('procedure SetBounds(x,y,w,h: Integer);virtual;');
|
|
RegisterProperty('Left', 'Integer', iptRW);
|
|
RegisterProperty('Top', 'Integer', iptRW);
|
|
RegisterProperty('Width', 'Integer', iptRW);
|
|
RegisterProperty('Height', 'Integer', iptRW);
|
|
RegisterProperty('Hint', 'String', iptRW);
|
|
RegisterProperty('Align', 'TAlign', iptRW);
|
|
RegisterProperty('ClientHeight', 'Longint', iptRW);
|
|
RegisterProperty('ClientWidth', 'Longint', iptRW);
|
|
RegisterProperty('ShowHint', 'Boolean', iptRW);
|
|
RegisterProperty('Visible', 'Boolean', iptRW);
|
|
RegisterProperty('ENABLED', 'BOOLEAN', iptrw);
|
|
RegisterProperty('HINT', 'STRING', iptrw);
|
|
|
|
{$IFNDEF MINIVCL}
|
|
RegisterMethod('function Dragging: Boolean;');
|
|
RegisterProperty('HasParent', 'Boolean', iptr);
|
|
RegisterMethod('procedure BEGINDRAG(IMMEDIATE:BOOLEAN)');
|
|
RegisterMethod('function CLIENTTOSCREEN(POINT:TPOINT):TPOINT');
|
|
RegisterMethod('procedure ENDDRAG(DROP:BOOLEAN)');
|
|
{$IFNDEF CLX}
|
|
RegisterMethod('function GETTEXTBUF(BUFFER:PCHAR;BUFSIZE:INTEGER):INTEGER');
|
|
RegisterMethod('function GETTEXTLEN:INTEGER');
|
|
RegisterMethod('procedure SETTEXTBUF(BUFFER:PCHAR)');
|
|
RegisterMethod('function PERFORM(MSG:CARDINAL;WPARAM,LPARAM:LONGINT):LONGINT');
|
|
{$ENDIF}
|
|
RegisterMethod('function SCREENTOCLIENT(POINT:TPOINT):TPOINT');
|
|
RegisterProperty('CURSOR', 'TCURSOR', iptrw);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure SIRegisterTWinControl(Cl: TIFPSCompileTimeClassesImporter); // requires TControl
|
|
begin
|
|
with Cl.Add2(cl.FindClass('TControl'), 'TWINCONTROL') do
|
|
begin
|
|
|
|
with Cl.FindClass('TControl') do
|
|
begin
|
|
RegisterProperty('Parent', 'TWinControl', iptRW);
|
|
end;
|
|
|
|
{$IFNDEF CLX}
|
|
RegisterProperty('Handle', 'Longint', iptRW);
|
|
{$ENDIF}
|
|
RegisterProperty('Showing', 'Boolean', iptR);
|
|
RegisterProperty('TabOrder', 'Integer', iptRW);
|
|
RegisterProperty('TabStop', 'Boolean', iptRW);
|
|
RegisterMethod('function CANFOCUS:BOOLEAN');
|
|
RegisterMethod('function FOCUSED:BOOLEAN');
|
|
RegisterProperty('CONTROLS', 'TCONTROL INTEGER', iptr);
|
|
RegisterProperty('CONTROLCOUNT', 'INTEGER', iptr);
|
|
|
|
{$IFNDEF MINIVCL}
|
|
RegisterMethod('function HandleAllocated: Boolean;');
|
|
RegisterMethod('procedure HandleNeeded;');
|
|
RegisterMethod('procedure EnableAlign;');
|
|
RegisterMethod('procedure RemoveControl(AControl: TControl);');
|
|
RegisterMethod('procedure InsertControl(AControl: TControl);');
|
|
RegisterMethod('procedure Realign;');
|
|
RegisterMethod('procedure ScaleBy(M, D: Integer);');
|
|
RegisterMethod('procedure ScrollBy(DeltaX, DeltaY: Integer);');
|
|
RegisterMethod('procedure SetFocus; virtual;');
|
|
{$IFNDEF CLX}
|
|
RegisterMethod('procedure PAINTTO(DC:Longint;X,Y:INTEGER)');
|
|
{$ENDIF}
|
|
RegisterMethod('function CONTAINSCONTROL(CONTROL:TCONTROL):BOOLEAN');
|
|
RegisterMethod('procedure DISABLEALIGN');
|
|
RegisterMethod('procedure UPDATECONTROLSTATE');
|
|
RegisterProperty('BRUSH', 'TBRUSH', iptr);
|
|
RegisterProperty('HELPCONTEXT', 'LONGINT', iptrw);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
procedure SIRegisterTGraphicControl(cl: TIFPSCompileTimeClassesImporter); // requires TControl
|
|
begin
|
|
Cl.Add2(cl.FindClass('TControl'), 'TGRAPHICCONTROL');
|
|
end;
|
|
|
|
procedure SIRegisterTCustomControl(cl: TIFPSCompileTimeClassesImporter); // requires TWinControl
|
|
begin
|
|
Cl.Add2(cl.FindClass('TWinControl'), 'TCUSTOMCONTROL');
|
|
end;
|
|
|
|
procedure SIRegister_Controls_TypesAndConsts(Cl: TIFPSCompileTimeClassesImporter);
|
|
begin
|
|
Cl.se.AddTypeS('TMouseEvent', 'procedure(Sender: TObject; Button: Byte; Shift: Byte; X, Y: Integer);');
|
|
cl.se.AddTypeS('TMouseMoveEvent', 'procedure(Sender: TObject; Shift: Byte; X, Y: Integer);');
|
|
cl.se.AddTypeS('TKeyEvent', 'procedure(Sender: TObject; var Key: Word; Shift: Byte);');
|
|
cl.se.AddTypeS('TKeyPressEvent', 'procedure(Sender: TObject; var Key: Char);');
|
|
cl.se.AddTypeS('TMouseButton', '(mbLeft, mbRight, mbMiddle)');
|
|
cl.se.AddTypeS('TDragMode', '(dmManual, dmAutomatic)');
|
|
cl.se.AddTypeS('TDragState', '(dsDragEnter, dsDragLeave, dsDragMove)');
|
|
cl.se.AddTypeS('TDragKind', '(dkDrag, dkDock)');
|
|
cl.se.AddTypeS('TDragOverEvent', 'procedure(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean)');
|
|
cl.se.AddTypeS('TDragDropEvent', 'procedure(Sender, Source: TObject;X, Y: Integer)');
|
|
cl.se.AddTypeS('TEndDragEvent', 'procedure(Sender, Target: TObject; X, Y: Integer)');
|
|
|
|
cl.se.addTypeS('TAlign', '(alNone, alTop, alBottom, alLeft, alRight, alClient)');
|
|
|
|
cl.se.AddConstantN('akLeft', 'Byte')^.Value.tu8 := 1;
|
|
cl.se.AddConstantN('akTop', 'Byte')^.Value.tu8 := 2;
|
|
cl.se.AddConstantN('akRight', 'Byte')^.Value.tu8 := 4;
|
|
cl.se.AddConstantN('akbottom', 'Byte')^.Value.tu8 := 8;
|
|
cl.se.AddConstantN('mrNone', 'Integer')^.Value.ts32 := 0;
|
|
cl.se.AddConstantN('mrOk', 'Integer')^.Value.ts32 := 1;
|
|
cl.se.AddConstantN('mrCancel', 'Integer')^.Value.ts32 := 2;
|
|
cl.se.AddConstantN('mrAbort', 'Integer')^.Value.ts32 := 3;
|
|
cl.se.AddConstantN('mrRetry', 'Integer')^.Value.ts32 := 4;
|
|
cl.se.AddConstantN('mrIgnore', 'Integer')^.Value.ts32 := 5;
|
|
cl.se.AddConstantN('mrYes', 'Integer')^.Value.ts32 := 6;
|
|
cl.se.AddConstantN('mrNo', 'Integer')^.Value.ts32 := 7;
|
|
cl.se.AddConstantN('mrAll', 'Integer')^.Value.ts32 := 8;
|
|
cl.se.AddConstantN('mrNoToAll', 'Integer')^.Value.ts32 := 9;
|
|
cl.se.AddConstantN('mrYesToAll', 'Integer')^.Value.ts32 := 10;
|
|
cl.se.AddConstantN('crDefault', 'Integer')^.Value.ts32 := 0;
|
|
cl.se.AddConstantN('crNone', 'Integer')^.Value.ts32 := -1;
|
|
cl.se.AddConstantN('crArrow', 'Integer')^.Value.ts32 := -2;
|
|
cl.se.AddConstantN('crCross', 'Integer')^.Value.ts32 := -3;
|
|
cl.se.AddConstantN('crIBeam', 'Integer')^.Value.ts32 := -4;
|
|
cl.se.AddConstantN('crSize', 'Integer')^.Value.ts32 := -22;
|
|
cl.se.AddConstantN('crSizeNESW', 'Integer')^.Value.ts32 := -6;
|
|
cl.se.AddConstantN('crSizeNS', 'Integer')^.Value.ts32 := -7;
|
|
cl.se.AddConstantN('crSizeNWSE', 'Integer')^.Value.ts32 := -8;
|
|
cl.se.AddConstantN('crSizeWE', 'Integer')^.Value.ts32 := -9;
|
|
cl.se.AddConstantN('crUpArrow', 'Integer')^.Value.ts32 := -10;
|
|
cl.se.AddConstantN('crHourGlass', 'Integer')^.Value.ts32 := -11;
|
|
cl.se.AddConstantN('crDrag', 'Integer')^.Value.ts32 := -12;
|
|
cl.se.AddConstantN('crNoDrop', 'Integer')^.Value.ts32 := -13;
|
|
cl.se.AddConstantN('crHSplit', 'Integer')^.Value.ts32 := -14;
|
|
cl.se.AddConstantN('crVSplit', 'Integer')^.Value.ts32 := -15;
|
|
cl.se.AddConstantN('crMultiDrag', 'Integer')^.Value.ts32 := -16;
|
|
cl.se.AddConstantN('crSQLWait', 'Integer')^.Value.ts32 := -17;
|
|
cl.se.AddConstantN('crNo', 'Integer')^.Value.ts32 := -18;
|
|
cl.se.AddConstantN('crAppStart', 'Integer')^.Value.ts32 := -19;
|
|
cl.se.AddConstantN('crHelp', 'Integer')^.Value.ts32 := -20;
|
|
end;
|
|
|
|
procedure SIRegister_Controls(Cl: TIFPSCompileTimeClassesImporter);
|
|
begin
|
|
SIRegister_Controls_TypesAndConsts(cl);
|
|
|
|
SIRegisterTControl(Cl);
|
|
SIRegisterTWinControl(Cl);
|
|
SIRegisterTGraphicControl(cl);
|
|
SIRegisterTCustomControl(cl);
|
|
end;
|
|
|
|
// MiniVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
|
|
|
end.
|