home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / BLX11.ZIP / NAV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-21  |  1.8 KB  |  70 lines
  1. {Listing 1. NAV.PAS.}
  2. {$X+}
  3. program Navigate; (* by Tom Swan *)
  4. uses Dos,Objects,Drivers,Views,Menus,App,StdDlg;
  5. const
  6.     cmChangeDir = 1000;
  7. type
  8.     TNavApp = object(TApplication)
  9.         procedure HandleEvent(var Event: TEvent); virtual;
  10.         procedure InitMenuBar; virtual;
  11.         procedure InitStatusLine; virtual;
  12.     end;
  13. procedure TNavApp.HandleEvent(var Event: TEvent);
  14. procedure ChangeDir;
  15. var
  16.     D: PChDirDialog;
  17. begin
  18.     D := New(PChDirDialog, Init(cdNormal, 101)); 
  19.     if ValidView(D) <> nil then begin
  20.         DeskTop^.ExecView(D); 
  21.         Dispose(D, Done);
  22.     end; 
  23. end;
  24. begin
  25.     TApplication.HandleEvent(Event); 
  26.     if Event.What = evCommand then begin
  27.         if Event.Command = cmChangeDir
  28.             then ChangeDir 
  29.             else Exit;
  30.         ClearEvent(Event); 
  31.     end;
  32. end;
  33. procedure TNavApp.InitMenuBar;
  34. var
  35.     R: TRect;
  36. begin
  37.     GetExtent(R); 
  38.     R.B.Y := R.A.Y + 1; 
  39.     MenuBar := New(PMenuBar, Init(R, NewMenu(
  40.         NewSubMenu('Menu', hcNoContext, NewMenu(
  41.             NewItem('Change Dir', 'F3', kbF3, cmChangeDir, 
  42.                            hcNoContext,
  43.             NewItem('Exit', 'Alt-X', kbAltX, cmQuit, 
  44.                            hcNoContext, nil))), nil)))); 
  45. end;
  46. procedure TNavApp.InitStatusLine;
  47. var
  48.     R: TRect;
  49. begin
  50.     GetExtent(R); 
  51.     R.A.Y := R.B.Y - 1; 
  52.     StatusLine := New(PStatusLine, Init(R,
  53.     NewStatusDef(0, $FFFF,
  54.         NewStatusKey('', kbF10, cmMenu, 
  55.         NewStatusKey('Alt-X Exit', kbAltX, cmQuit,
  56.         NewStatusKey('F3 Change Dir', kbF3, cmChangeDir, nil))), nil)));
  57. end;
  58.  
  59. var
  60.     NavApp: TNavApp; NavEvent: TEvent;
  61. begin
  62.     NavApp.Init;
  63.     NavEvent.what := evCommand;
  64.     NavEvent.Command := cmChangeDir;
  65.     NavEvent.InfoPtr := nil;
  66.     NavApp.PutEvent(NavEvent);
  67.     NavApp.Run;
  68.     NavApp.Done;
  69. end.
  70.