home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FINPUT.ZIP / TESTCASE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-01-01  |  2.3 KB  |  111 lines
  1. program Test_FInput;
  2. {$X+}
  3. uses App, Objects, Menus, Views, Drivers, Memory, Dialogs,
  4.      FInput;
  5.  
  6. const
  7.   cmOpenTestWindow = 1000;
  8.  
  9. type
  10.   PMyApp = ^TMyApp;
  11.   TMyApp = object(TApplication)
  12.     procedure InitStatusLine; virtual;
  13.     procedure InitMenuBar; virtual;
  14.     procedure HandleEvent(var Event: TEvent); virtual;
  15.   end;
  16.  
  17.   PMyTestWindow = ^TMyTestWindow;
  18.   TMyTestWindow = object(TDialog)
  19.     constructor Init(Bounds: TRect; WinTitle: string);
  20.   end;
  21.  
  22. var
  23.   MyApp: TMyApp;
  24.  
  25.  
  26. constructor TMyTestWindow.Init(Bounds: TRect; WinTitle: string);
  27. var
  28.   R: TRect;
  29.   Fld, Labl : PView;
  30. begin
  31.   TDialog.Init(Bounds, WinTitle);
  32.   R.Assign(8,3,18,4);
  33.   Fld := new(PFInputLine, Init(R, 8, DDateSet, DDate, 0));
  34.   Insert(Fld);
  35.  
  36.     R.Assign(1,3,7,4);
  37.     Labl := new(PLabel, Init(R, 'Date:', Fld));
  38.     Insert(Labl);
  39.  
  40.   R.Assign(8,4,18,5);
  41.   Fld := new(PFInputLine, Init(R, 8, DTimeSet, DTime, 0));
  42.   Insert(Fld);
  43.  
  44.     R.Assign(1,4,7,5);
  45.     Labl := new(PLabel, Init(R, 'Time:', Fld));
  46.     Insert(Labl);
  47.  
  48. end;
  49.  
  50. procedure TMyApp.InitStatusLine;
  51. var
  52.   R : TRect;
  53. begin
  54.   GetExtent(R);
  55.   R.A.Y := R.B.Y - 1;
  56.   StatusLine := new(PStatusLine, Init(R,
  57.     NewStatusDef(0, $FFFF,
  58.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  59.       NewStatusKey('~F5~ Zoom', kbF5, cmZoom,
  60.       NewStatusKey('~F6~ Next', kbF6, cmNext,
  61.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  62.       nil)))),
  63.     nil)
  64.   ));
  65. end;
  66.  
  67. procedure TMyApp.InitMenuBar;
  68. var
  69.   R: TRect;
  70. begin
  71.   GetExtent(R);
  72.   R.B.Y := R.A.Y + 1;
  73.   MenuBar := new(PMenuBar,Init(R, NewMenu(
  74.     NewSubMenu('~T~est', hcNoContext, NewMenu(
  75.       NewItem('~N~ew Window', '', kbNoKey, cmOpenTestWindow, hcNoContext,
  76.       NewLine(
  77.       NewItem('E~x~it','Alt-X', kbAltX, cmQuit, hcNoContext,
  78.       nil)))),nil))));
  79. end;
  80.  
  81. procedure TMyApp.HandleEvent(var Event: TEvent);
  82.  
  83.   procedure OpenTestWindow;
  84.   var
  85.     R: TRect;
  86.   begin
  87.     R.Assign(30,10,54,18);
  88.     DeskTop^.Insert(new(PMyTestWindow, Init(R, 'Test Window')));
  89.   end;
  90.  
  91. begin
  92.   TApplication.HandleEvent(Event);
  93.   case Event.What of
  94.     evCommand:
  95.       begin
  96.         case Event.Command of
  97.           cmOpenTestWindow:    OpenTestWindow;
  98.         else
  99.           Exit;
  100.         end;
  101.         ClearEvent(Event);
  102.       end;
  103.   end;
  104. end;
  105.  
  106. begin
  107.   MyApp.Init;
  108.   MyApp.Run;
  109.   MyApp.Done;
  110. end.
  111.