mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-11 01:52:16 -05:00
215 lines
9.5 KiB
ObjectPascal
215 lines
9.5 KiB
ObjectPascal
|
{ 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.
|