v0.7 PSMenus

Warning

Esta ayuda es para la versión 0.7. Está obsoleta e incompleta.

{ 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 : TC'
   +'ANVAS; ARECT : TRECT; SELECTED : BOOLEAN)');
  Cl.addTypeS('TADVANCEDMENUDRAWITEMEVENT', 'Procedure ( SENDER : TOBJECT; ACAN'
   +'VAS : 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 : TMENU'
   +'ITEM; 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) : T'
   +'SHORTCUT');
  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 : STR'
   +'ING; 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 : WO'
   +'RD; 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 : W'
   +'ORD; 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.