nav.pas

汇编源代码大全2

{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.