IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Turbo Vision, Не работает процедура Open
сообщение
Сообщение #1


Гость






Помогите пожалуйста с Turbo Vision! Мне нужно сделать информационно-справочную систему... да не важно... В общем процедура Open не работает! Можете посмотреть, пожалуйста, в чем проблема?


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.

 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 17.04.2024 6:23
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name