/pascalscript/Source/uPSC_menus.pas
Pascal | 214 lines | 177 code | 26 blank | 11 comment | 1 complexity | 316db4fdb207d89980fe7073e195282d MD5 | raw file
Possible License(s): GPL-3.0, Apache-2.0, BSD-3-Clause, LGPL-3.0, LGPL-2.1
- { Menus Import Unit }
- Unit uPSC_menus;
- {$I PascalScript.inc}
- Interface
- Uses uPSCompiler;
-
- procedure SIRegisterTMENUITEMSTACK(CL: TPSPascalCompiler);
- procedure SIRegisterTPOPUPLIST(CL: TPSPascalCompiler);
- procedure SIRegisterTPOPUPMENU(CL: TPSPascalCompiler);
- procedure SIRegisterTMAINMENU(CL: TPSPascalCompiler);
- procedure SIRegisterTMENU(CL: TPSPascalCompiler);
- procedure SIRegisterTMENUITEM(CL: TPSPascalCompiler);
- procedure SIRegister_Menus(Cl: TPSPascalCompiler);
-
- implementation
-
- procedure SIRegisterTMENUITEMSTACK(CL: TPSPascalCompiler);
- begin
- With cl.AddClassN(Cl.FindClass('TStack'),'TMenuItemStack') do
- begin
- RegisterMethod('procedure ClearItem(AItem: TMenuItem)');
- end;
- end;
-
- procedure SIRegisterTPOPUPLIST(CL: TPSPascalCompiler);
- begin
- With cl.AddClassN(Cl.FindClass('TList'),'TPopupList') do
- begin
- RegisterProperty('Window', 'HWND', iptr);
- RegisterMethod('procedure Add(Popup: TPopupMenu)');
- RegisterMethod('procedure Remove(Popup: TPopupMenu)');
- end;
- end;
-
- procedure SIRegisterTPOPUPMENU(CL: TPSPascalCompiler);
- var
- cc: TPSCompileTimeClass;
- begin
- With cl.AddClassN(Cl.FindClass('TMenu'),'TPopupMenu') do
- begin
- cc := Cl.FindClass('TLabel');
- if cc <> nil then
- RegisterProperty('PopupMenu', 'TPopupMenu', iptRW);
- with Cl.FindClass('TForm') do
- begin
- RegisterProperty('PopupMenu', 'TPopupMenu', iptRW);
- end;
- RegisterMethod('constructor Create(AOwner: TComponent)');
- RegisterMethod('procedure Popup(X, Y: Integer)');
- RegisterProperty('PopupComponent', 'TComponent', iptrw);
- RegisterProperty('Alignment', 'TPopupAlignment', iptrw);
- RegisterProperty('AutoPopup', 'Boolean', iptrw);
- RegisterProperty('HelpContext', 'THelpContext', iptrw);
- RegisterProperty('MenuAnimation', 'TMenuAnimation', iptrw);
- RegisterProperty('TrackButton', 'TTrackButton', iptrw);
- RegisterProperty('OnPopup', 'TNotifyEvent', iptrw);
- end;
- end;
-
- procedure SIRegisterTMAINMENU(CL: TPSPascalCompiler);
- begin
- With cl.AddClassN(Cl.FindClass('TMenu'),'TMainMenu') do
- begin
- RegisterMethod('procedure Merge(Menu: TMainMenu)');
- RegisterMethod('procedure Unmerge(Menu: TMainMenu)');
- RegisterMethod('procedure PopulateOle2Menu(SharedMenu: HMENU; Groups: array of Integer; var Widths: array of LongInt)');
- RegisterMethod('procedure GetOle2AcceleratorTable(var AccelTable: HACCEL; var AccelCount: Integer; Groups: array of Integer)');
- RegisterMethod('procedure SetOle2MenuHandle(Handle: HMENU)');
- RegisterProperty('AutoMerge', 'Boolean', iptrw);
- end;
- end;
-
- procedure SIRegisterTMENU(CL: TPSPascalCompiler);
- begin
- With cl.AddClassN(Cl.FindClass('TComponent'),'TMenu') do
- begin
- RegisterMethod('constructor Create(AOwner: TComponent)');
- RegisterMethod('function DispatchCommand(ACommand: Word): Boolean');
- RegisterMethod('function DispatchPopup(AHandle: HMENU): Boolean');
- RegisterMethod('function FindItem(Value: Integer; Kind: TFindItemKind): TMenuItem');
- RegisterMethod('function GetHelpContext(Value: Integer; ByCommand: Boolean): THelpContext');
- RegisterProperty('Images', 'TCustomImageList', iptrw);
- RegisterMethod('function IsRightToLeft: Boolean');
- RegisterMethod('procedure ParentBiDiModeChanged(AControl: TObject)');
- RegisterMethod('procedure ProcessMenuChar(var Message: TWMMenuChar)');
- RegisterProperty('AutoHotkeys', 'TMenuAutoFlag', iptrw);
- RegisterProperty('AutoLineReduction', 'TMenuAutoFlag', iptrw);
- RegisterProperty('BiDiMode', 'TBiDiMode', iptrw);
- RegisterProperty('Handle', 'HMENU', iptr);
- RegisterProperty('OwnerDraw', 'Boolean', iptrw);
- RegisterProperty('ParentBiDiMode', 'Boolean', iptrw);
- RegisterProperty('WindowHandle', 'HWND', iptrw);
- RegisterProperty('Items', 'TMenuItem', iptr);
- end;
- end;
-
- procedure SIRegisterTMENUITEM(CL: TPSPascalCompiler);
- begin
- With cl.AddClassN(Cl.FindClass('TComponent'),'TMenuItem') do
- begin
- RegisterMethod('constructor Create(AOwner: TComponent)');
- RegisterMethod('procedure InitiateAction');
- RegisterMethod('procedure Insert(Index: Integer; Item: TMenuItem)');
- RegisterMethod('procedure Delete(Index: Integer)');
- RegisterMethod('procedure Clear');
- RegisterMethod('procedure Click');
- RegisterMethod('function Find(ACaption: string): TMenuItem');
- RegisterMethod('function IndexOf(Item: TMenuItem): Integer');
- RegisterMethod('function IsLine: Boolean');
- RegisterMethod('function GetImageList: TCustomImageList');
- RegisterMethod('function GetParentComponent: TComponent');
- RegisterMethod('function GetParentMenu: TMenu');
- RegisterMethod('function HasParent: Boolean');
- RegisterMethod('function NewTopLine: Integer');
- RegisterMethod('function NewBottomLine: Integer');
- RegisterMethod('function InsertNewLineBefore(AItem: TMenuItem): Integer');
- RegisterMethod('function InsertNewLineAfter(AItem: TMenuItem): Integer');
- RegisterMethod('procedure Add(Item: TMenuItem)');
- RegisterMethod('procedure Remove(Item: TMenuItem)');
- RegisterMethod('function RethinkHotkeys: Boolean');
- RegisterMethod('function RethinkLines: Boolean');
- RegisterProperty('Command', 'Word', iptr);
- RegisterProperty('Handle', 'HMENU', iptr);
- RegisterProperty('Count', 'Integer', iptr);
- RegisterProperty('Items', 'TMenuItem Integer', iptr);
- RegisterProperty('MenuIndex', 'Integer', iptrw);
- RegisterProperty('Parent', 'TMenuItem', iptr);
- {$IFDEF DELPHI5UP}
- RegisterProperty('Action', 'TBasicAction', iptrw);
- {$ENDIF}
- RegisterProperty('AutoHotkeys', 'TMenuItemAutoFlag', iptrw);
- RegisterProperty('AutoLineReduction', 'TMenuItemAutoFlag', iptrw);
- RegisterProperty('Bitmap', 'TBitmap', iptrw);
- RegisterProperty('Caption', 'string', iptrw);
- RegisterProperty('Checked', 'Boolean', iptrw);
- RegisterProperty('SubMenuImages', 'TCustomImageList', iptrw);
- RegisterProperty('Default', 'Boolean', iptrw);
- RegisterProperty('Enabled', 'Boolean', iptrw);
- RegisterProperty('GroupIndex', 'Byte', iptrw);
- RegisterProperty('HelpContext', 'THelpContext', iptrw);
- RegisterProperty('Hint', 'string', iptrw);
- RegisterProperty('ImageIndex', 'TImageIndex', iptrw);
- RegisterProperty('RadioItem', 'Boolean', iptrw);
- RegisterProperty('ShortCut', 'TShortCut', iptrw);
- RegisterProperty('Visible', 'Boolean', iptrw);
- RegisterProperty('OnClick', 'TNotifyEvent', iptrw);
- {$IFNDEF FPC} RegisterProperty('OnDrawItem', 'TMenuDrawItemEvent', iptrw);
- RegisterProperty('OnAdvancedDrawItem', 'TAdvancedMenuDrawItemEvent', iptrw);
- RegisterProperty('OnMeasureItem', 'TMenuMeasureItemEvent', iptrw);{$ENDIF}
- end;
- end;
-
- procedure SIRegister_Menus(Cl: TPSPascalCompiler);
- begin
- Cl.AddTypeS('HMENU', 'Cardinal');
- Cl.AddTypeS('HACCEL', 'Cardinal');
-
- cl.addClassN(cl.FindClass('Exception'),'EMenuError');
- Cl.addTypeS('TMenuBreak', '(mbNone, mbBreak, mbBarBreak)');
- {$IFNDEF FPC}
- Cl.addTypeS('TMenuDrawItemEvent', 'procedure (Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean)');
-
- Cl.addTypeS('TAdvancedMenuDrawItemEvent', 'procedure (Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState)');
-
- Cl.addTypeS('TMenuMeasureItemEvent', 'procedure (Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer)');
-
- {$ENDIF}
- Cl.addTypeS('TMenuItemAutoFlag', '(maAutomatic, maManual, maParent)');
- Cl.AddTypeS('TMenuAutoFlag', 'TMenuItemAutoFlag');
- Cl.addTypeS('TShortCut', 'Word');
- cl.addClassN(cl.FindClass('TActionLink'),'TMenuActionLink');
- SIRegisterTMENUITEM(Cl);
- Cl.addTypeS('TMenuChangeEvent', 'procedure (Sender: TObject; Source: TMenuItem; Rebuild: Boolean)');
-
- Cl.addTypeS('TFindItemKind', '(fkCommand, fkHandle, fkShortCut)');
- SIRegisterTMENU(Cl);
- SIRegisterTMAINMENU(Cl);
- Cl.addTypeS('TPopupAlignment', '(paLeft, paRight, paCenter)');
- Cl.addTypeS('TTrackButton', '(tbRightButton, tbLeftButton)');
- Cl.addTypeS('TMenuAnimations', '(maLeftToRight, maRightToLeft, maTopToBottom, maBottomToTop, maNone)');
-
- Cl.addTypeS('TMenuAnimation', 'set of TMenuAnimations');
- SIRegisterTPOPUPMENU(Cl);
- SIRegisterTPOPUPLIST(Cl);
- SIRegisterTMENUITEMSTACK(Cl);
- Cl.addTypeS('TCMenuItem', 'TMenuItem');
- {$IFNDEF FPC}
- //TODO: it should work,but somehow TShiftState is not defined
- Cl.AddDelphiFunction('function ShortCut(Key: Word; Shift: TShiftState): TShortCut');
-
- Cl.AddDelphiFunction('procedure ShortCutToKey(ShortCut: TShortCut; var Key: Word; var Shift: TShiftState)');
-
- {$ENDIF}
- Cl.AddDelphiFunction('function ShortCutToText(ShortCut: TShortCut): string');
-
- Cl.AddDelphiFunction('function TextToShortCut(Text: string): TShortCut');
- Cl.AddDelphiFunction('function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu');
-
- Cl.AddDelphiFunction('function NewPopupMenu(Owner: TComponent; const AName: string; Alignment: TPopupAlignment; AutoPopup: Boolean; const Items: array of TCMenuItem): TPopupMenu');
-
-
- Cl.AddDelphiFunction('function NewSubMenu(const ACaption: string; HCTX: Word; const AName: string; Items: array of TMenuItem; AEnabled: Boolean): TMenuItem');
-
- Cl.AddDelphiFunction('function NewItem(const ACaption: string; AShortCut: TShortCut; Achecked, AEnabled: Boolean; AOnClick: TNotifyEvent; HCTX: Word; const AName: string): TMenuItem');
-
-
- Cl.AddDelphiFunction('function NewLine: TMenuItem');
- {$IFNDEF FPC}
- Cl.AddDelphiFunction('procedure DrawMenuItem(MenuItem: TMenuItem; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState)');
-
- {$ENDIF}
- end;
-
- end.