home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CICA 1992 November
/
CICA_MS_Windows_CD-ROM_Walnut_Creek_November_1992.iso
/
win3
/
programr
/
listings
/
blxv1
/
nav.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-01-22
|
2KB
|
70 lines
{Listing 1. NAV.PAS.}
{$X+}
program Navigate; (* by Tom Swan *)
uses Dos,Objects,Drivers,Views,Menus,App,StdDlg;
const
cmChangeDir = 1000;
type
TNavApp = object(TApplication)
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitMenuBar; virtual;
procedure InitStatusLine; virtual;
end;
procedure TNavApp.HandleEvent(var Event: TEvent);
procedure ChangeDir;
var
D: PChDirDialog;
begin
D := New(PChDirDialog, Init(cdNormal, 101));
if ValidView(D) <> nil then begin
DeskTop^.ExecView(D);
Dispose(D, Done);
end;
end;
begin
TApplication.HandleEvent(Event);
if Event.What = evCommand then begin
if Event.Command = cmChangeDir
then ChangeDir
else Exit;
ClearEvent(Event);
end;
end;
procedure TNavApp.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('Menu', hcNoContext, NewMenu(
NewItem('Change Dir', 'F3', kbF3, cmChangeDir,
hcNoContext,
NewItem('Exit', 'Alt-X', kbAltX, cmQuit,
hcNoContext, nil))), nil))));
end;
procedure TNavApp.InitStatusLine;
var
R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := New(PStatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('', kbF10, cmMenu,
NewStatusKey('Alt-X Exit', kbAltX, cmQuit,
NewStatusKey('F3 Change Dir', kbF3, cmChangeDir, nil))), nil)));
end;
var
NavApp: TNavApp; NavEvent: TEvent;
begin
NavApp.Init;
NavEvent.what := evCommand;
NavEvent.Command := cmChangeDir;
NavEvent.InfoPtr := nil;
NavApp.PutEvent(NavEvent);
NavApp.Run;
NavApp.Done;
end.