home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / oop.swg / 0052_Example Static Menu Bar.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-28  |  1.7 KB  |  80 lines
  1. {
  2.  
  3. This program is an example that will display static text
  4. in a static menubar above the active menubar.
  5.  
  6. }
  7. program ExtraMenuBar;
  8.  
  9. uses Objects, Drivers, Views, Menus, App;
  10.  
  11. const
  12.   cmFileOpen = 100;
  13.   cmNewWin   = 101;
  14.  
  15. type
  16.   PExtraMenuBar = ^TExtraMenuBar;
  17.   TExtraMenuBar = object(TMenuBar)
  18.    procedure Draw;virtual;
  19.   end;
  20.  
  21.   TMyApp = object(TApplication)
  22.     ExtraMenuBar : PExtraMenuBar;
  23.     procedure InitMenuBar; virtual;
  24.     procedure InitStatusLine; virtual;
  25.   end;
  26.  
  27.  
  28. procedure TExtraMenuBar.Draw;
  29. const
  30.  ProgName : String = '                                    Program Name'+
  31.                      '                                 ';
  32. begin
  33. TMenuBar.Draw;
  34. WriteStr(0,0,ProgName,$06);
  35. end;
  36.  
  37. { TMyApp }
  38. procedure TMyApp.InitMenuBar;
  39. var R: TRect;
  40. begin
  41.   GetExtent(R);
  42.   ExtraMenuBar := New(PExtraMenuBar,Init(R,nil));
  43.   Insert(ExtraMenuBar);
  44.   R.B.Y := R.A.Y + 2;
  45.   R.A.Y := 1;
  46.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  47.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  48.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  49.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  50.       NewLine(
  51.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  52.       nil))))),
  53.       nil))));
  54. end;
  55.  
  56. procedure TMyApp.InitStatusLine;
  57. var R: TRect;
  58. begin
  59.   GetExtent(R);
  60.   R.A.Y := R.B.Y - 1;
  61.   StatusLine := New(PStatusLine, Init(R,
  62.     NewStatusDef(0, $FFFF,
  63.       NewStatusKey('', kbF10, cmMenu,
  64.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  65.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  66.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  67.       nil)))),
  68.     nil)
  69.   ));
  70. end;
  71.  
  72. var
  73.   MyApp: TMyApp;
  74.  
  75. begin
  76.   MyApp.Init;
  77.   MyApp.Run;
  78.   MyApp.Done;
  79. end.
  80.