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

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

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

> Turbo Vision, Не работает процедура Open
-Dimon-FX-
сообщение 14.04.2007 11:31
Сообщение #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);
         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);
         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);
         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

 

- Текстовая версия 26.07.2025 6:44
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"