home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp6goodi / toggle / hello.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-01-31  |  4.4 KB  |  162 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. program Hello;
  11.  
  12. uses Objects,  Drivers, Views, Menus, Dialogs, App,
  13. {***}     Dos, Help_Cmd, Screen;
  14.  
  15. const
  16.   GreetThemCmd = 100;
  17.  
  18. type
  19.   PHelloApp = ^THelloApp;
  20.   THelloApp = object(TApplication)
  21.  
  22. {***}    Toggles : PToggleKeysView;
  23. {***}    constructor Init;
  24. {***}    procedure Idle; virtual;
  25.  
  26.     procedure GreetingBox;
  27.     procedure HandleEvent(var Event: TEvent); virtual;
  28.     procedure InitMenuBar; virtual;
  29.     procedure InitStatusLine; virtual;
  30.   end;
  31.  
  32. { THelloApp }
  33. {***}   constructor THelloApp.Init;
  34. {***}   
  35. {***}   var
  36. {***}     R: TRect;
  37. {***}   
  38. {***}   begin
  39. {***}     TApplication.Init;
  40. {***}     GetExtent(R);
  41. {***}     Dec(R.B.X);
  42. {***}     R.A.X := R.B.X - 16;
  43. {***}     R.A.Y := R.B.Y - 1;
  44. {***}     Toggles := New(PToggleKeysView, Init(R) );
  45. {***}     insert( Toggles );
  46. {***}   end;
  47. {***}   
  48. {***}   procedure THelloApp.Idle;
  49. {***}   
  50. {***}   begin
  51. {***}     TApplication.Idle;
  52. {***}     Toggles^.UpDate;
  53. {***}     CheckIfKeyPressed( THelloApp.GetHelpCtx );
  54. {***}   end;
  55.  
  56.  
  57. procedure THelloApp.GreetingBox;
  58. var
  59.   R: TRect;
  60.   D: PDialog;
  61.   C: Word;
  62. begin
  63.   { Create a dialog }
  64.   R.Assign(25, 5, 55, 16);
  65.   D := New(PDialog, Init(R, 'Hello, World!'));
  66.  
  67.   { Create and insert controls into the dialog}
  68.   R.Assign(3, 5, 15, 6);
  69.   D^.Insert(New(PStaticText, Init(R, 'How are you?')));
  70.  
  71.   R.Assign(16, 2, 28, 4);
  72.   D^.Insert(New(PButton, Init(R, 'Terrific', cmCancel, bfNormal)));
  73.  
  74.   R.Assign(16, 4, 28, 6);
  75.   D^.Insert(New(PButton, Init(R, 'Ok', cmCancel, bfNormal)));
  76.  
  77.   R.Assign(16, 6, 28, 8);
  78.   D^.Insert(New(PButton, Init(R, 'Lousy', cmCancel, bfNormal)));
  79.  
  80.   R.Assign(16, 8, 28, 10);
  81.   D^.Insert(  New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  82.  
  83.   { Execute the modal dialog }
  84.   C := DeskTop^.ExecView(D);
  85. end;
  86.  
  87. procedure THelloApp.HandleEvent(var Event: TEvent);
  88. begin
  89.   TApplication.HandleEvent(Event);
  90.   if Event.What = evCommand then
  91.   begin
  92.     case Event.Command of
  93.       GreetThemCmd: GreetingBox;
  94.     else
  95.       Exit;
  96.     end;
  97.     ClearEvent(Event);
  98.   end;
  99. end;
  100.  
  101. procedure THelloApp.InitMenuBar;
  102. var
  103.   R: TRect;
  104. begin
  105.   GetExtent(R);
  106.   R.B.Y := R.A.Y + 1;
  107.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  108.     NewSubMenu('~H~ello', hcNoContext, NewMenu(
  109.       NewItem('~G~reeting...','', 0, GreetThemCmd, hcNoContext,
  110.       NewLine(
  111.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  112.       nil)))),
  113.     nil))));
  114. end;
  115.  
  116. procedure THelloApp.InitStatusLine;
  117. var
  118.   R: TRect;
  119. begin
  120.   GetExtent(R);
  121.   R.A.Y := R.B.Y-1;
  122.   StatusLine := New(PStatusLine, Init(R,
  123. {***
  124.   Note the change in help context range, from $FFFF to 0.
  125.   This would normaly be the last 'normal' help context.
  126.   At the bottom of the help context list would be Shift, Ctrl and Alt.
  127. ***}
  128.     NewStatusDef(0, 0,
  129.       NewStatusKey('', kbF10, cmMenu,
  130.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  131.       nil)),
  132. {***}    NewStatusDef(hcShiftKeys, hcShiftkeys,
  133. {***}      NewStatusKey('Shift: ~F6~-Previous', kbNoKey, cmNoCommand,
  134. {***}      NewStatusKey('~Del~-Cut', kbNoKey, cmNoCommand,
  135. {***}      NewStatusKey('~Ins~-Paste', kbNoKey, cmNoCommand,
  136. {***}      nil))),
  137. {***}    NewStatusDef(hcCtrlKeys, hcCtrlKeys,
  138. {***}      NewStatusKey('Ctrl: ~Ins~-Copy',kbNoKey, cmNoCommand,
  139. {***}      NewStatusKey('~Del~-Clear', kbNoKey, cmNoCommand,
  140. {***}      NewStatusKey('~F5~-Size/Move', kbNoKey, cmNoCommand,
  141. {***}      NewStatusKey('~QF~-Find', kbNoKey, cmNoCommand,
  142. {***}      NewStatusKey('~QA~-Replace', kbNoKey, cmNoCommand,
  143. {***}      NewStatusKey('~L~-Search Again', kbNoKey, cmNoCommand,
  144. {***}      nil)))))),
  145. {***}    NewStatusDef(hcAltKeys, hcAltKeys,
  146. {***}      NewStatusKey('Alt: ~X~-Exit', kbAltX, cmQuit,
  147. {***}      NewStatusKey('~F3~-Close', kbNoKey, cmNoCommand,
  148. {***}      NewStatusKey('~F5~-DOS Screen', kbNoKey, cmNoCommand,
  149. {***}      NewStatusKey('~F9~-Compile', kbNoKey, cmNoCommand,
  150. {***}      nil)))),
  151.     nil))))));
  152. end;
  153.  
  154. var
  155.   HelloWorld: THelloApp;
  156.  
  157. begin
  158.   HelloWorld.Init;
  159.   HelloWorld.Run;
  160.   HelloWorld.Done;
  161. end.
  162.