home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / bkgrnd.zip / SAMPLE.PAS < prev    next >
Pascal/Delphi Source File  |  1994-08-07  |  3KB  |  108 lines
  1. {  Demonstrates using TDOSDesktop  }
  2. program Sample;
  3.  
  4. uses
  5.   App,       { Turbo Vision unit  }
  6.   Dialogs,   {  Turbo Vision unit  }
  7.   Drivers,   {  Turbo Vision unit  }
  8.   DOSBkGnd,  {  Contains definition of TDOSDesktop  }
  9.   Memory,    {  Turbo Vision unit  }
  10.   Objects,   {  Turbo Vision unit  }
  11.   Views;     {  Turbo Vision unit  }
  12.  
  13. type
  14.  
  15.   TSampleApp =
  16.     object  (TProgram)
  17.     constructor Init;
  18.     destructor Done; virtual;
  19.     procedure InitDesktop; virtual;
  20.     procedure InitMenuBar; virtual;
  21.     procedure InitStatusLine; virtual;
  22.     end;  {  of TOptionsApp  }
  23.  
  24.   PTestDialog = ^TTestDialog;
  25.   TTestDialog =
  26.     object (TDialog)
  27.     constructor Init;
  28.     procedure HandleEvent (var Event : TEvent); virtual;
  29.     end;  {  of TTestDialog  }
  30.  
  31. {**Definition of TSampleApp object methods**}
  32.  
  33. constructor TSampleApp.Init;
  34.   begin
  35.   InitMemory;
  36.   InitVideoDOS;  {  required - must use instead of InitVideo  }
  37.   InitEvents;
  38.   InitSysError;
  39.   inherited Init;
  40.   InsertWindow (new (PTestDialog, Init));
  41.   end;  {  of constructor Init  }
  42.  
  43. destructor TSampleApp.Done;
  44.   begin
  45.   inherited Done;
  46.   DoneSysError;
  47.   DoneEvents;
  48.   DoneVideoDOS;  {  required - must use instead of DoneVideo  }
  49.   DoneMemory;
  50.   end;  {  of destructor Done  }
  51.  
  52. procedure TSampleApp.InitDesktop;
  53.   var
  54.     R : TRect;
  55.   begin
  56.   GetExtent(R);
  57.   Desktop := new (PDOSDesktop, Init);
  58.   end;  {  of procedure InitDesktop  }
  59.  
  60. procedure TSampleApp.InitMenuBar;
  61.   begin
  62.   MenuBar := nil;
  63.   end;  {  of procedure InitMenuBar  }
  64.  
  65. procedure TSampleApp.InitStatusLine;
  66.   begin
  67.   StatusLine := nil;
  68.   end;  {  of procedure InitStatusLine  }
  69.  
  70. {**Definition of methods for TTestDialog**}
  71.  
  72. constructor TTestDialog.Init;
  73.   var
  74.     R : TRect;
  75.   begin
  76.   R.Assign (5, 10, 42, 17);
  77.   inherited Init (R, 'Sample');
  78.  
  79.   R.Assign (4, 3, 35, 4);
  80.   insert (new (PStaticText, Init (R, 'Press [ESC] to exit SampleApp')));
  81.   end;  {  of constructor Init  }
  82.  
  83. procedure TTestDialog.HandleEvent
  84.   (
  85.   var Event : TEvent  {  Input and output  }
  86.   );
  87.   begin
  88.   if (Event.What = evCommand) and (Event.Command = cmClose)
  89.     then begin
  90.     Event.Command := cmQuit;
  91.     end;  {  if  }
  92.   if (Event.What = evKeyDown) and (Event.Keycode = kbEsc)
  93.     then begin
  94.     Event.What := evCommand;
  95.     Event.Command := cmQuit;
  96.     end;  {  if  }
  97.   inherited HandleEvent (Event);
  98.   end;  {  of procedure HandleEvent  }
  99.  
  100. var
  101.   SampleApp : TSampleApp;
  102.  
  103. begin
  104. writeln ('Press [ESC] to exit SampleApp');
  105. SampleApp.Init;
  106. SampleApp.Run;
  107. SampleApp.Done;
  108. end.  {  of program  }