home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / T-Pascal.70 / DOCDEMO.ZIP / TUTOR03B.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-30  |  3KB  |  114 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor03b;
  9.  
  10. uses TutConst, Drivers, Objects, Views, Menus, App, MsgBox;
  11.  
  12. type
  13.   TTutorApp = object(TApplication)
  14.     procedure DoAboutBox;
  15.     procedure HandleEvent(var Event: TEvent); virtual;
  16.     procedure InitMenuBar; virtual;
  17.     procedure InitStatusLine; virtual;
  18.   end;
  19.  
  20. procedure TTutorApp.DoAboutBox;
  21. begin
  22.   MessageBox(#3'Turbo Vision Tutorial Application'#13 +
  23.     #3'Copyright 1992'#13#3'Borland International',
  24.     nil, mfInformation or mfOKButton);
  25. end;
  26.  
  27. procedure TTutorApp.HandleEvent(var Event: TEvent);
  28. var
  29.   R: TRect;
  30. begin
  31.   inherited HandleEvent(Event);
  32.   if Event.What = evCommand then
  33.   begin
  34.     case Event.Command of
  35.       cmOptionsVideo:
  36.         begin
  37.           SetScreenMode(ScreenMode xor smFont8x8);
  38.           ClearEvent(Event);
  39.         end;
  40.       cmAbout:
  41.         begin
  42.           DoAboutBox;
  43.           ClearEvent(Event);
  44.         end;
  45.     end;
  46.   end;
  47. end;
  48.  
  49. procedure TTutorApp.InitMenuBar;
  50. var
  51.   R: TRect;
  52. begin
  53.   GetExtent(R);
  54.   R.B.Y := R.A.Y + 1;
  55.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  56.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  57.       StdFileMenuItems(nil)),
  58.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  59.       StdEditMenuItems(
  60.       NewLine(
  61.       NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
  62.       nil)))),
  63.     NewSubMenu('~O~rders', hcNoContext, NewMenu(
  64.       NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
  65.       NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
  66.       NewLine(
  67.       NewItem('Next', 'PgDn', kbPgDn, cmOrderNext, hcNoContext,
  68.       NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
  69.       nil)))))),
  70.     NewSubMenu('O~p~tions', hcNoContext, NewMenu(
  71.       NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
  72.       NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
  73.       NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
  74.       nil)))),
  75.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  76.       NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
  77.       NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
  78.       NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
  79.       NewLine(
  80.       StdWindowMenuItems(nil)))))),
  81.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  82.       NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
  83.       nil)),
  84.     nil))))))
  85.   )));
  86. end;
  87.  
  88. procedure TTutorApp.InitStatusLine;
  89. var
  90.   R: TRect;
  91. begin
  92.   GetExtent(R);
  93.   R.A.Y := R.B.Y - 1;
  94.   New(StatusLine, Init(R,
  95.     NewStatusDef(0, $EFFF,
  96.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  97.       NewStatusKey('~F4~ New', kbF4, cmNew,
  98.       NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  99.       StdStatusKeys(nil)))),
  100.     NewStatusDef($F000, $FFFF,
  101.       NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
  102.       NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
  103.       StdStatusKeys(nil))), nil))));
  104. end;
  105.  
  106. var
  107.   TutorApp: TTutorApp;
  108.  
  109. begin
  110.   TutorApp.Init;
  111.   TutorApp.Run;
  112.   TutorApp.Done;
  113. end.
  114.