home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / gravis / gv / gvmenus.int < prev    next >
Encoding:
Text File  |  1994-05-23  |  6.5 KB  |  260 lines
  1. Unit GVMenus;
  2.  
  3.  
  4. interface
  5.  
  6. uses Objects, Drivers, Views, GVViews, Memory;
  7.  
  8. Const
  9.  
  10. { Color palettes }
  11.  
  12.   CMenuView   = #2#3#4#5#6#7#8#9;
  13.   CStatusLine = #2#3#4#5#6#7#8#9;
  14.  
  15. { Disabled flags }
  16.  
  17.   dfDisabled   = $01;
  18.   dfMenuCheck  = $02;
  19.   dfRadio      = $04;
  20.   dfCheckState = $08;
  21.   dfBitmap     = $10;
  22.  
  23. Type
  24.  
  25. { TMenu types }
  26.  
  27.   TMenuStr = string[31];
  28.  
  29.   PMenu = ^TMenu;
  30.  
  31.   PMenuItem = ^TMenuItem;
  32.   TMenuItem = record
  33.     Next: PMenuItem;
  34.     Name: Pointer;     { als Name PString ; als Bitmap Pointer }
  35.     Command: Word;
  36.     Disabled: Byte;
  37.     KeyCode: Word;
  38.     HelpCtx: Word;
  39.     case Integer of
  40.       0: (Param: PString);
  41.       1: (SubMenu: PMenu);
  42.   end;
  43.  
  44.   TMenu = record
  45.     Items: PMenuItem;
  46.     Default: PMenuItem;
  47.   end;
  48.  
  49. { TMenuView object }
  50.  
  51.   { Palette layout }
  52.   { 1 = Normal text }
  53.   { 2 = Disabled text }
  54.   { 3 = Shortcut text }
  55.   { 4 = Normal selection }
  56.   { 5 = Disabled selection }
  57.   { 6 = Shortcut selection }
  58.   { 7 = Normal background }
  59.   { 8 = Selected background }
  60.  
  61.   PMenuView = ^TMenuView;
  62.   TMenuView = object(TGView)
  63.     ParentMenu: PMenuView;
  64.     Menu: PMenu;
  65.     Current: PMenuItem;
  66.     constructor Init(var Bounds: TRect);
  67.     constructor Load(var S: TStream);
  68.     procedure DrawItem (Item: PMenuItem); virtual;
  69.     function Execute: Word; virtual;
  70.     function FindItem(Ch: Char): PMenuItem;
  71.     procedure GetItemRect(Item: PMenuItem; var R: TRect); virtual;
  72.     function GetHelpCtx: Word; virtual;
  73.     function GetPalette: PPalette; virtual;
  74.     procedure HandleEvent(var Event: TEvent); virtual;
  75.     function HotKey(KeyCode: Word): PMenuItem;
  76.     function NewSubView(var Bounds: TRect; AMenu: PMenu;
  77.       AParentMenu: PMenuView): PMenuView; virtual;
  78.     procedure Store(var S: TStream);
  79.   private
  80.     PopupFlag: Boolean;
  81.     OldCurrent: PMenuItem;
  82.     EndState: Word;
  83.     procedure GetRect (Menus: PMenu; var Bounds: TRect);
  84.     procedure DoSubMenu (var Item: PMenuItem; Mouse: Boolean;
  85.         var Event: TEvent);
  86.   end;
  87.  
  88. { TMenuBar object }
  89.  
  90.   { Palette layout }
  91.   { 1 = Normal text }
  92.   { 2 = Disabled text }
  93.   { 3 = Shortcut text }
  94.   { 4 = Normal selection }
  95.   { 5 = Disabled selection }
  96.   { 6 = Shortcut selection }
  97.   { 7 = Normal background }
  98.   { 8 = Selected background }
  99.  
  100.   PMenuBar = ^TMenuBar;
  101.   TMenuBar = object(TMenuView)
  102.     constructor Init(var Bounds: TRect; AMenu: PMenu);
  103.     destructor Done; virtual;
  104.     procedure Draw; virtual;
  105.     procedure DrawItem (Item: PMenuItem); virtual;
  106.     procedure GetItemRect(Item: PMenuItem; var R: TRect); virtual;
  107.   end;
  108.  
  109. { TMenuBox object }
  110.  
  111.   { Palette layout }
  112.   { 1 = Normal text }
  113.   { 2 = Disabled text }
  114.   { 3 = Shortcut text }
  115.   { 4 = Normal selection }
  116.   { 5 = Disabled selection }
  117.   { 6 = Shortcut selection }
  118.   { 7 = Normal background }
  119.   { 8 = Selected background }
  120.  
  121.   PMenuBox = ^TMenuBox;
  122.   TMenuBox = object(TMenuView)
  123.     constructor Init(var Bounds: TRect; AMenu: PMenu;
  124.       AParentMenu: PMenuView);
  125.     procedure Draw; virtual;
  126.     procedure DrawItem (Item: PMenuItem); virtual;
  127.     procedure GetItemRect(Item: PMenuItem; var R: TRect); virtual;
  128.   end;
  129.  
  130. { TMenuPopup object }
  131.  
  132.   { Palette layout }
  133.   { 1 = Normal text }
  134.   { 2 = Disabled text }
  135.   { 3 = Shortcut text }
  136.   { 4 = Normal selection }
  137.   { 5 = Disabled selection }
  138.   { 6 = Shortcut selection }
  139.   { 7 = Normal background }
  140.   { 8 = Selected background }
  141.  
  142.   PMenuPopup = ^TMenuPopup;
  143.   TMenuPopup = object(TMenuBox)
  144.     constructor Init(var Bounds: TRect; AMenu: PMenu);
  145.     function Execute: Word; virtual;
  146.     procedure HandleEvent(var Event: TEvent); virtual;
  147.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  148.   end;
  149.  
  150. { TStatusItem }
  151.  
  152.   PStatusItem = ^TStatusItem;
  153.   TStatusItem = record
  154.     Next: PStatusItem;
  155.     Text: PString;
  156.     KeyCode: Word;
  157.     Command: Word;
  158.   end;
  159.  
  160. { TStatusDef }
  161.  
  162.   PStatusDef = ^TStatusDef;
  163.   TStatusDef = record
  164.     Next: PStatusDef;
  165.     Min, Max: Word;
  166.     Items: PStatusItem;
  167.   end;
  168.  
  169. { TStatusLine }
  170.  
  171.   { Palette layout }
  172.   { 1 = Normal text }
  173.   { 2 = Disabled text }
  174.   { 3 = Shortcut text }
  175.   { 4 = Normal selection }
  176.   { 5 = Disabled selection }
  177.   { 6 = Shortcut selection }
  178.   { 7 = Normal background }
  179.   { 8 = Selected background }
  180.  
  181.   PStatusLine = ^TStatusLine;
  182.   TStatusLine = object(TGView)
  183.     Items: PStatusItem;
  184.     Defs: PStatusDef;
  185.     constructor Init (var Bounds: TRect; ADefs: PStatusDef);
  186.     constructor Load (var S: TStream);
  187.     destructor Done; virtual;
  188.     procedure Draw; virtual;
  189.     function GetPalette: PPalette; virtual;
  190.     procedure HandleEvent(var Event: TEvent); virtual;
  191.     function Hint (AHelpCtx: Word): String; virtual;
  192.     procedure Store (var S: TStream);
  193.     procedure Update; virtual;
  194.   private
  195.     HelpContext: Word;
  196.     Current: PStatusDef;
  197.     CItem: PStatusItem;
  198.     procedure GetItemRect (Item: PStatusItem; var R: TRect);
  199.     procedure DrawItem (Item: PStatusItem);
  200.     procedure DrawHint;
  201.   end;
  202.  
  203. { TMenuItem routines }
  204.  
  205. function NewItem(Name, Param: TMenuStr; KeyCode: Word; Command: Word;
  206.   AHelpCtx: Word; Next: PMenuItem): PMenuItem;
  207. function NewBitmap(Bitmap: Pointer; KeyCode: Word; Command: Word;
  208.   AHelpCtx: Word; Next: PMenuItem): PMenuItem;
  209. function NewLine(Next: PMenuItem): PMenuItem;
  210. function NewSubMenu(Name: TMenuStr; AHelpCtx: Word; SubMenu: PMenu;
  211.   Next: PMenuItem): PMenuItem;
  212. function NewBmpSubMenu(Bitmap: Pointer; AHelpCtx: Word; SubMenu: PMenu;
  213.   Next: PMenuItem): PMenuItem;
  214.  
  215. { TMenu routines }
  216.  
  217. function NewMenu(Items: PMenuItem): PMenu;
  218. procedure DisposeMenu(Menu: PMenu);
  219.  
  220. { TStatusLine routines }
  221.  
  222. function NewStatusDef(AMin, AMax: Word; AItems: PStatusItem;
  223.   ANext: PStatusDef): PStatusDef;
  224. function NewStatusKey(AText: String; AKeyCode: Word; ACommand: Word;
  225.   ANext: PStatusItem): PStatusItem;
  226.  
  227. { GVMenus registration procedure }
  228.  
  229. procedure RegisterGVMenus;
  230.  
  231. const
  232.  
  233. { Stream registration records }
  234.  
  235.   RMenuBar: TStreamRec = (
  236.      ObjType: 41;
  237.      VmtLink: Ofs(TypeOf(TMenuBar)^);
  238.      Load:    @TMenuBar.Load;
  239.      Store:   @TMenuBar.Store);
  240.  
  241.   RMenuBox: TStreamRec = (
  242.      ObjType: 42;
  243.      VmtLink: Ofs(TypeOf(TMenuBox)^);
  244.      Load:    @TMenuBox.Load;
  245.      Store:   @TMenuBox.Store);
  246.  
  247.   RStatusLine: TStreamRec = (
  248.      ObjType: 43;
  249.      VmtLink: Ofs(TypeOf(TStatusLine)^);
  250.      Load:    @TStatusLine.Load;
  251.      Store:   @TStatusLine.Store);
  252.  
  253.   RMenuPopup: TStreamRec = (
  254.      ObjType: 44;
  255.      VmtLink: Ofs(TypeOf(TMenuPopup)^);
  256.      Load:    @TMenuPopup.Load;
  257.      Store:   @TMenuPopup.Store);
  258.  
  259. implementation
  260.