/pascalscript/Source/uPSC_menus.pas

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