home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / TP.7_1 / TP / EXAMPLES / DOCDEMOS / HINTER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-05  |  2.3 KB  |  88 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Hinter;
  9.  
  10. uses Objects, Drivers, Menus, Views, App;
  11.  
  12. const
  13.   hcFile = 1001; hcFileNew = 1002; hcFileOpen = 1003;
  14.   hcFileExit = 1004; hcTest = 1005; hcWindow = 1100;
  15.   cmFileNew = 98; cmFileOpen = 99;
  16.  
  17. type
  18.   PHintStatusLine = ^THintStatusLine;
  19.   THintStatusLine = object(TStatusLine)
  20.     function Hint(AHelpCtx: Word): String; virtual;
  21.   end;
  22.   THintApp = object(TApplication)
  23.     constructor Init;
  24.     procedure InitMenuBar; virtual;
  25.     procedure InitStatusLine; virtual;
  26.   end;
  27.  
  28. function THintStatusLine.Hint(AHelpCtx: Word): String;
  29. begin
  30.   case AHelpCtx of
  31.     hcDragging: Hint := 'You''re dragging me!';
  32.     hcFile: Hint := 'This is the File menu';
  33.     hcFileNew: Hint := 'Create a new file';
  34.     hcFileOpen: Hint := 'Open an existing file';
  35.     hcFileExit: Hint := 'Terminate the application';
  36.     hcTest: Hint := 'This is a test. This is only a test.';
  37.     hcWindow: Hint := 'This is a window';
  38.   else
  39.     Hint := '';
  40.   end;
  41. end;
  42.  
  43. constructor THintApp.Init;
  44. var
  45.   R: TRect;
  46.   Window: PWindow;
  47. begin
  48.   inherited Init;
  49.   Desktop^.GetExtent(R);
  50.   Window := New(PWindow, Init(R, 'A window', wnNoNumber));
  51.   Window^.HelpCtx := hcWindow;
  52.   InsertWindow(Window);
  53. end;
  54.  
  55. procedure THintApp.InitMenuBar;
  56. var
  57.   R: TRect;
  58. begin
  59.   GetExtent(R);
  60.   R.B.Y := R.A.Y + 1;
  61.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  62.     NewSubMenu('~F~ile', hcFile, NewMenu(
  63.       NewItem('~N~ew', '', kbNoKey, cmFileNew, hcFileNew,
  64.       NewItem('~O~pen...', 'F3', kbF3, cmFileOpen, hcFileOpen,
  65.       NewLine(
  66.       NewItem('E~x~it', 'Alt+X', kbAltX, cmQuit, hcFileExit,
  67.       nil))))),
  68.     NewItem('~T~est', '', kbNoKey, cmError, hcTest, nil)))));
  69. end;
  70.  
  71. procedure THintApp.InitStatusLine;
  72. var
  73.   R: TRect;
  74. begin
  75.   GetExtent(R);
  76.   R.A.Y := R.B.Y - 1;
  77.   StatusLine := New(PHintStatusLine, Init(R,
  78.     NewStatusDef(0, $FFFF, StdStatusKeys(nil), nil)));
  79. end;
  80.  
  81. var
  82.   HintApp: THintApp;
  83. begin
  84.   HintApp.Init;
  85.   HintApp.Run;
  86.   HintApp.Done;
  87. end.
  88.