home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / gravis / gv / gvguid03.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-23  |  1.8 KB  |  71 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Demo program from the Turbo Vision Guide     }
  5. {                                                }
  6. {   Copyright (c) 1990 by Borland International  }
  7. {                                                }
  8. {************************************************}
  9.  
  10. { modifiziert für Graphics Vision von Stefan Milius }
  11.  
  12. program GVGUID03;
  13.  
  14. uses Objects, Drivers, Views, GVViews, GVMenus, GVApp;
  15.  
  16. const
  17.   cmFileOpen = 100;
  18.   cmNewWin   = 101;
  19.  
  20. type
  21.   TMyApp = object(TApplication)
  22.     procedure InitMenuBar; virtual;
  23.     procedure InitStatusLine; virtual;
  24.   end;
  25.  
  26. { TMyApp }
  27. procedure TMyApp.InitMenuBar;
  28. var R: TRect;
  29. begin
  30.   GetExtent(R);
  31.   R.B.Y := R.A.Y + 21;
  32.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  33.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  34.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  35.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  36.       NewLine(
  37.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  38.       nil))))),
  39.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  40.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  41.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  42.       nil))),
  43.     nil))
  44.   )));
  45. end;
  46.  
  47. procedure TMyApp.InitStatusLine;
  48. var R: TRect;
  49. begin
  50.   GetExtent(R);
  51.   R.A.Y := R.B.Y - 21;
  52.   StatusLine := New(PStatusLine, Init(R,
  53.     NewStatusDef(0, $FFFF,
  54.       NewStatusKey('', kbF10, cmMenu,
  55.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  56.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  57.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  58.       nil)))),
  59.     nil)
  60.   ));
  61. end;
  62.  
  63. var
  64.   MyApp: TMyApp;
  65.  
  66. begin
  67.   MyApp.Init;
  68.   MyApp.Run;
  69.   MyApp.Done;
  70. end.
  71.