home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ENHMEN.ZIP / ENHMENUS.INT < prev    next >
Encoding:
Text File  |  1991-03-29  |  11.5 KB  |  268 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O+,R-,S-,V+,X-}
  2. {$M 16384,0,655360}
  3. Unit EnhMenus;
  4.  
  5. Interface
  6. Uses Objects, Drivers, Views;
  7.  
  8. Type
  9.  
  10. { TMenu types }
  11.  
  12.   TMenuStr                   =   string[31];
  13.  
  14.   PMenu                      =   ^TMenu;
  15.   PMenuMetaView              =   ^TMenuMetaView;
  16.  
  17.   PMenuItem                  =   ^TMenuItem;
  18.   TMenuItem                  =   Object (TObject)
  19.                                     Next         :   PMenuItem;
  20.                                     Name         :   PString;
  21.                                     Param        :   PString;
  22.                                     View         :   PView;
  23.                                     KeyCode      :   Word;
  24.                                     HelpCtx      :   Word;
  25.  
  26.                                     Constructor  Init(aName, aParam:TMenuStr; aKeyCode, aHelpCtx:Word; aNext:PMenuItem);
  27.                                     Constructor  Load(var S:TStream);
  28.                                     Destructor   Done; virtual;
  29.                                     Procedure    Store(var S:TStream); virtual;
  30.                                     Function     Execute(ParentMenu:PMenuMetaView):Word; virtual;
  31.                                     Procedure    Pull(ParentMenu:PMenuMetaView; On:Boolean); virtual;
  32.                                     Function     HotKey(aKeyCode:Word):PMenuItem; virtual;
  33.                                     Function     Command:Word; virtual;
  34.                                  End;
  35.  
  36.   PMenuCommand               =   ^TMenuCommand;
  37.   TMenuCommand               =   Object(TMenuItem)
  38.                                     Constructor  Init(aName, aParam:TMenuStr; aKeyCode, aCommand, aHelpCtx:Word;
  39.                                                     aNext:PMenuItem);
  40.                                     Constructor  Load(var S:TStream);
  41.                                     Procedure    Store(var S:TStream); virtual;
  42.                                     Function     Command:Word; virtual;
  43.  
  44.                                     Private
  45.                                     _Command     :   Word;
  46.                                  End;
  47.  
  48.   PMenuSubMenu               =   ^TMenuSubMenu;
  49.   TMenuSubMenu               =   Object (TMenuItem)
  50.                                     SubMenu      :   PMenu;
  51.  
  52.                                     Constructor  Init(aName, aParam:TMenuStr; aKeyCode, aHelpCtx:Word;
  53.                                                     aSubMenu:PMenu; aNext:PMenuItem);
  54.                                     Constructor  Load(var S:TStream);
  55.                                     Destructor   Done; virtual;
  56.                                     Procedure    Store(var S:TStream); virtual;
  57.                                     Function     Execute(ParentMenu:PMenuMetaView):Word; virtual;
  58.                                     Procedure    Pull(ParentMenu:PMenuMetaView; On:Boolean); virtual;
  59.                                     Function     HotKey(aKeyCode:Word):PMenuItem; virtual;
  60.                                  End;
  61.  
  62.   TMenu                      =   Object (TObject)
  63.                                     Items        :   PMenuItem;
  64.                                     Default      :   PMenuItem;
  65.  
  66.                                     Constructor  Init(aItems:PMenuItem);
  67.                                     Constructor  Load(var S:TStream);
  68.                                     Destructor   Done; virtual;
  69.                                     Procedure    Store(var S:TStream); virtual;
  70.                                     Function     HotKey(aKeyCode:Word):PMenuItem; virtual;
  71.                                  End;
  72.  
  73. { TStatusDef }
  74.  
  75.   PStatusDef                 =   ^TStatusDef;
  76.   TStatusDef                 =   Object (TMenu)
  77.                                     Min, Max     :   Word;
  78.                                     Next         :   PStatusDef;
  79.  
  80.                                     Constructor  Init(aMin, aMax:Word; aItems:PMenuItem; aNext:PStatusDef);
  81.                                     Constructor  Load(var S:TStream);
  82.                                     Procedure    Store(var S:TStream); virtual;
  83.                                  End;
  84.  
  85. { TOptionView object }
  86.  
  87.   { Palette layout }
  88.   { 1 = Normal text }
  89.   { 2 = Disabled text }
  90.   { 3 = Shortcut text }
  91.   { 4 = Normal selection }
  92.   { 5 = Disabled selection }
  93.   { 6 = Shortcut selection }
  94.  
  95.   TMenuMetaView              =   Object(TView)
  96.                                     Current      :   PMenuItem;
  97.                                     ParentMenu   :   PMenuMetaView;
  98.  
  99.                                     Constructor  Init(var Bounds:TRect);
  100.                                     Constructor  Load(var S:TStream);
  101.                                     Function     Menu:PMenu; virtual;
  102.                                     Function     Execute:Word; virtual;
  103.                                     Procedure    EndModal(Command:Word); virtual;
  104.                                     Function     FindItem(Ch:Char):PMenuItem;
  105.                                     Procedure    ChangeCurrent(Item:PMenuItem); virtual;
  106.                                     Procedure    GetItemRect(Item:PMenuItem; var R:TRect); virtual;
  107.                                     Function     ItemAt(P:TPoint):PMenuItem;
  108.                                     Function     GetHelpCtx:Word; virtual;
  109.                                     Procedure    HandleEvent(var Event:TEvent); virtual;
  110.                                     Procedure    Activate(Item:PMenuItem); virtual;
  111.                                     Function     HotKey(aKeyCode:Word):PMenuItem; virtual;
  112.                                     Function     MouseInMenus(Where:TPoint):Boolean;
  113.  
  114.                                     Private
  115.                                     EndState      :   Word;
  116.                                  End;
  117.  
  118.   PMenuView                  =   ^TMenuView;
  119.   TMenuView                  =   Object(TMenuMetaView)
  120.                                     TrapKeys     :   Byte;
  121.  
  122.                                     Constructor  Init(var Bounds:TRect; aMenu:PMenu; aParentMenu:PMenuMetaView);
  123.                                     Constructor  Load(var S: TStream);
  124.                                     Destructor   Done; virtual;
  125.                                     Procedure    Store(var S:TStream); virtual;
  126.                                     Function     Menu:PMenu; virtual;
  127.                                     Function     GetPalette:PPalette; virtual;
  128.                                     Procedure    HandleEvent(var Event:TEvent); virtual;
  129.  
  130.                                     Private
  131.                                     _Menu        :   PMenu;
  132.                                  End;
  133.  
  134.   PMenuBar                   =   ^TMenuBar;
  135.   TMenuBar                   =   Object(TMenuView)
  136.                                     Constructor  Init(var Bounds:TRect; aMenu:PMenu);
  137.                                     Procedure    HandleEvent(Var Event:TEvent); virtual;
  138.                                     Procedure    Draw; virtual;
  139.                                     Procedure    GetItemRect(Item:PMenuItem; var R:TRect); virtual;
  140.                                  End;
  141.  
  142.   PMenuBox                   =   ^TMenuBox;
  143.   TMenuBox                   =   Object(TMenuView)
  144.                                     Constructor  Init(var Bounds:TRect; aMenu:PMenu;
  145.                                                       aParentMenu:PMenuMetaView);
  146.                                     Procedure    HandleEvent(Var Event:TEvent); virtual;
  147.                                     Procedure    Draw; virtual;
  148.                                     Procedure    GetItemRect(Item:PMenuItem; var R:TRect); virtual;
  149.                                  End;
  150.  
  151. { TStatusLine }
  152.  
  153.   { Palette layout }
  154.   { 1 = Normal text }
  155.   { 2 = Disabled text }
  156.   { 3 = Shortcut text }
  157.   { 4 = Normal selection }
  158.   { 5 = Disabled selection }
  159.   { 6 = Shortcut selection }
  160.  
  161.   PStatusLine                =   ^TStatusLine;
  162.   TStatusLine                =   Object(TMenuMetaView)
  163.                                     Defs         :   PStatusDef;
  164.                                     CurrentDef   :   PStatusDef;
  165.  
  166.                                     Constructor  Init(var Bounds:TRect; aDefs:PStatusDef);
  167.                                     Constructor  Load(var S:TStream);
  168.                                     Destructor   Done; virtual;
  169.                                     Procedure    Store(var S:TStream); virtual;
  170.                                     Function     Menu:PMenu; virtual;
  171.                                     Function     GetPalette:PPalette; virtual;
  172.                                     Procedure    GetItemRect(Item:PMenuItem; var R:TRect); virtual;
  173.                                     Procedure    Draw; virtual;
  174.                                     Procedure    HandleEvent(var Event:TEvent); virtual;
  175.                                     Function     Hint(aHelpCtx:Word):String; virtual;
  176.                                     Procedure    Update; virtual;
  177.                                     Procedure    Activate(Item:PMenuItem); virtual;
  178.  
  179.                                     Private
  180.                                     CurHelpCtx  :   Word;
  181.                                     Procedure   FindCurrent;
  182.                                  End;
  183.  
  184. Const
  185. { Color palettes }
  186.    CMenuView                 =   #2#3#4#5#6#7;
  187.    CStatusLine               =   #2#3#4#5#6#7;
  188.    sfPulled                  =   $1000;
  189.    sfUpdate                  =   $2000;
  190.    ofPull                    =   $0400;
  191.  
  192. { Stream registration records }
  193.   RMenuItem: TStreamRec = (
  194.      ObjType: 1000;
  195.      VmtLink: Ofs(TypeOf(TMenuItem)^);
  196.      Load:    @TMenuItem.Load;
  197.      Store:   @TMenuItem.Store
  198.   );
  199.   RMenuSubMenu: TStreamRec = (
  200.      ObjType: 1002;
  201.      VmtLink: Ofs(TypeOf(TMenuSubMenu)^);
  202.      Load:    @TMenuSubMenu.Load;
  203.      Store:   @TMenuSubMenu.Store
  204.   );
  205.   RMenuCommand: TStreamRec = (
  206.      ObjType: 1003;
  207.      VmtLink: Ofs(TypeOf(TMenuCommand)^);
  208.      Load:    @TMenuCommand.Load;
  209.      Store:   @TMenuCommand.Store
  210.   );
  211.   RMenu: TStreamRec = (
  212.      ObjType: 1004;
  213.      VmtLink: Ofs(TypeOf(TMenu)^);
  214.      Load:    @TMenu.Load;
  215.      Store:   @TMenu.Store
  216.   );
  217.   RMenuBar: TStreamRec = (
  218.      ObjType: 40;
  219.      VmtLink: Ofs(TypeOf(TMenuBar)^);
  220.      Load:    @TMenuBar.Load;
  221.      Store:   @TMenuBar.Store
  222.   );
  223.   RMenuBox: TStreamRec = (
  224.      ObjType: 41;
  225.      VmtLink: Ofs(TypeOf(TMenuBox)^);
  226.      Load:    @TMenuBox.Load;
  227.      Store:   @TMenuBox.Store
  228.   );
  229.  
  230.   RStatusDef: TStreamRec = (
  231.      ObjType: 1005;
  232.      VmtLink: Ofs(TypeOf(TStatusDef)^);
  233.      Load:    @TStatusDef.Load;
  234.      Store:   @TStatusDef.Store
  235.   );
  236.   RStatusLine: TStreamRec = (
  237.      ObjType: 42;
  238.      VmtLink: Ofs(TypeOf(TStatusLine)^);
  239.      Load:    @TStatusLine.Load;
  240.      Store:   @TStatusLine.Store
  241.   );
  242.  
  243.  
  244. Procedure RegisterMenus;
  245.  
  246. { TMenuItem routines }
  247.  
  248. Function NewItem(Name, Param:TMenuStr; KeyCode:Word; Command:Word;
  249.   aHelpCtx:Word; Next:PMenuItem):PMenuItem;
  250. Function NewLine(Next:PMenuItem):PMenuItem;
  251. Function NewSubMenu(Name:TMenuStr; aHelpCtx:Word; SubMenu:PMenu;
  252.   Next:PMenuItem):PMenuItem;
  253.  
  254. { TMenu routines }
  255.  
  256. Function NewMenu(Items:PMenuItem):PMenu;
  257. Procedure DisposeMenu(Menu:PMenu);
  258.  
  259. { TStatusLine routines }
  260.  
  261. Function NewStatusDef(aMin, aMax:Word;
  262.    aItems:PMenuItem; aNext:PStatusDef):PStatusDef;
  263. Function NewStatusKey(aText:String; aKeyCode:Word; aCommand:Word;
  264.    aNext:PMenuItem):PMenuItem;
  265. Function NewStatusMenu(aText:String; aHelpCtx, aKeyCode:Word; SubMenu:PMenu;
  266.    aNext:PMenuItem):PMenuItem;
  267.  
  268. Implementation