Program name;
uses crt,app,objects,menus,drivers,views,StdDlg,DOS;
const cmwork=203;
cmdos=204;
wincoml:tcommandset=[cmsave,cmwork];
type tnotebook=object(tapplication)
Procedure initmenubar;
virtual;
Procedure initstatusline;
virtual;
Procedure HandleEvent(var Event:TEvent);
virtual;
Procedure initstatussline;
virtual;
end;
Procedure tnotebook.initmenubar;
var r:trect;
begin
getextent®;
r.b.y:=succ(r.a.y);
menubar:=new(pmenubar,
init(r,
newmenu(
newsubmenu('~F~/ File',hcnocontext,
newmenu(
newitem('~1~/ Open','F3',kbF3,cmOpen,hcnocontext,
newitem('~2~/ Close','F2',kbF2,cmsave,hcnocontext,
newitem('~3~/ Change disk','',0,cmchangedir,hcnocontext,
newline(
newitem('~4~/ Shell DOS','',0,cmdosshell,hcnocontext,
newitem('~5~/ Exit','Alt-X',kbAltX,cmquit,hcnocontext,
nil))))))),
newitem('~W~/ Work','',kbF4,cmWork,hcnocontext,nil)))))
end;
Procedure tnotebook.initstatusline;
var r:trect;
begin
getextent®;
r.a.y:=pred(r.b.y);
statusline:=new(pstatusline,
init(r,
newstatusdef(0,$FFFF,
newstatuskey('~Alt-X~ Exit',kbAltX,cmQuit,
newstatuskey('~F2~ Close',kbF2,cmSave,
newstatuskey('~F3~ Open',kbF3,cmOpen,
newstatuskey('~F4~ Work',kbF4,cmWork,
newstatuskey('~F10~ Menu',kbF10,cmMenu,nil))))),nil)));
disablecommands(wincoml);
end;
Procedure tnotebook.initstatussline;
var r:trect;
begin
getextent®;
r.a.y:=pred(r.b.y);
statusline:=new(pstatusline,
init(r,
newstatusdef(0,$FFFF,
newstatuskey('~Alt-X~ Exit',kbaltx,cmquit,
newstatuskey('~F10~ Close',kbf10,cmclose,nil)),nil)));
end;
Procedure FileOpen;
var PF:PFileDialog;
Control:Word;
s:PathStr;
begin
New(PF,Init('*.dat','Vuberute nuzhnuy file:','Imya fayla',fdOpenButton,0));
Control:=DeskTop.ExecView(PF);
case Control of
StdDlg.cmFileOpen,cmOk:
begin
PF.QetFileName(s);
end;
end;
Dispose(PF,Done)
end;
end;
Procedure FileSave;
begin
end;
Procedure ChangeDir;
begin
end;
Procedure DOSCall;
begin
end;
Procedure Work;
begin
end;
Procedure TNotebook.HandleEvent(var Event:TEvent);
begin
Inherited HandleEvent(event);
if Event.What=evCommand then
case Event.Command of
cmOpen:FileOpen;
cmSave:FileSave;
cmChangeDir:ChangeDir;
cmDOSShell:DOSCall;
cmWork:Work
else exit;
end;
ClearEvent(Event);
end;
{-------------------------------------------------------------------------}
var notebook:tnotebook;
begin
clrscr;
notebook.init;
notebook.run;
notebook.done;
end.
Turbo Vision, Не работает процедура Open |