1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
При открытии файла 1.dat в котором содержится ФИО телефон адрес, программа не читает содержимое файла, прошу помощи у знатоков!
Uses App,Objects,Menus,Drivers,Views,MsgBox,StdDlg,Dos,Memory,Editors,Dialogs; {Используемые модули библиотеки Turbo Vision}
const {Команды для обработки событий:} cmWork=203;{Обработать данные} cmDOS=204;{Временно выйти из ДОС} WinComl:TCommandSet=[cmSave,cmWork];{Множество временно недоступных команд} WinCom2: TCommandSet = [cmOpen]; const LName = 25;{Длина поля Name} LPhone= 11;{Длина поля Phone} LAddr =40;{длина поля Addr}
const MaxLine = 300; {Максимальная длина массива} LLine = LName+LPhone+LAddr; {Длина строки} var NLines: Word; {Истинная длина массива строк} Lines: array [1..MaxLine] of String [LLine]; {Массив строк}
type DataType = record {Тип данных в файле} Name : String[LName]; {Имя} Phone: String[LPhone]; {Телефон} Addr : String[LAddr]; {Адрес} end; type TNotebook = object (TApplication) {Создаем объкт-потомок от TApplication} Procedure InitStatusLine; Virtual; Procedure InitMenuBar; Virtual; {Перекрываем стандартный метод InitMenuBar} Procedure HandleEvent(var Event: TEvent); Virtual; Procedure FileOpen; Procedure FileSave; Procedure ChangeDir; Procedure DOSCall; Procedure Work; end; type PWorkWin =^TWorkWin; TWorkWin = object (TWindow) Constructor Init(Bounds: TRect); end; type TInterior = object (TScroller) Location: Word; PS: PStringCollection; Constructor Init(var Bounds: TRect; HS,VS: PScrollBar); Procedure Draw; virtual; Procedure ReadFile; end;
Procedure TNotebook.InitMenuBar; {Создание верхнего меню} var R:TRect; begin GetExtent®; R.B.Y:=succ(R.A.Y); {R - координаты, строки мен} MenuBar := New (PMenuBar , Init(R, NewMenu ({Создаем меню} {Первый элемент нового меню представляет собой подменю (Меню второго уровня). Создаем его} NewSubMenu( '~F~/ Файл', hcNoContext,{Описываем элемент главного меню} NewMenu ( {Создаем подменю} NewItem({Первый элемент } '~1~/ Открыть ', 'F3' , kbF3,cmOpen, hcNoContext, NewItem({Второй элемент} '~2~/ Закрыть ', 'F2', kbF2, cmSave,hcNoContext, NewItem({Третий элемент} '~3~/ Сменить дис' , ' ' , 0, cmChangeDir,hcNoContext, NewLine ({Строка разделитель} NewItem('~4~/ Вызов ДОС', ' ' , 0, cmDOSShell,hcNoContext, NewItem('~5~/ Конец работы' , 'Alt-X' ,kbAltX, cmQuit, hcNoContext, NIL) ) ) ) ) ) {Нет других элементов подменю} ), {Создаем второй элемент главного меню} NewItem( '~W~/ Вызов ДОС', ' ', kbF4, cmWork, hcNoContext, NIL) {Нет других элементов главного меню} )))) end;
Procedure TNotebook.InitStatusLine;{Формирует строку статуса} var R: TRect; {Границы строки статуса} begin GetExtent ® ; {Получаем в R координаты всего экрана} R.A.Y := pred(R.B.Y) ; {Помещаем в R координаты строки статуса} StatusLine := New(PStatusLine, Init(R, {Создаем строку статуса} NewStatusDef (0, $FFFF, {Устанавливаем максимальный диапозон контекстной справочной службы} NewStatusKey('~Alt-X~ Выход', kbAltX, cmQuit, NewStatusKey('~F2~ Закрыть', kbF2, cmSave, NewStatusKey('~F3~ Открыть', kbF3,cmOpen, NewStatusKey('~F4~ Работа', kbF4,cmWork, NewStatusKey('~F10~ Меню', kbF10,cmMenu, NiL){Нет других клавишь})))), NiL){Нет других определений})); DisableCommands(WinComl) {Запрещаем недоступные команды} end;
Procedure TNotebook.HandleEvent(var Event: TEvent);{Обработчик событий программы} begin Inherited HandleEvent(Event);{Обработка стандартных команд cmQuit и cmMenu} 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;
Procedure TNotebook.FileOpen; {Открывает файл данных} begin {Создаем экземпляр динамического объекта:} New(PF, Init('*.dat','Выберите нужный файл:','Имя файла',fdOpenButton,0)); {С помощью следующего оператора окно выводится на экран и результат работы пользователя с ним помещается в переменную Control:} Control := DeskTop^.ExecView(PF);{Анализируем результат запроса:} case Control of StdDlg. cmFileOpen, cmOk: begin {Пользователь указал имя файла:} PF^.GetFileName(s); Assign(DataFile,s); {Отсюда начинаются новые строки} {$I-} Reset(DataFile); if IOResult <>0 then Rewrite(DataFile); OpFileF := IOResult=0; {$I+} if OpFileF then begin DisableCommands(WinCom2); EnableCommands(WinComl) end; end; end;
Dispose (PF, Done) {Уничтожаем экземпляр} end;
Procedure TNotebook.FileSave; begin Close(DataFile); OpFileF := False; EnableCommands(WinCom2); {Разрешаем открыть файл} DisableCommands(WinComl) {Запрещаем работу и сохранение} end;
Procedure TNotebook.ChangeDir; var PD: PChDirDialog; {Диалоговое окно смены каталога/диска} Control: Word; begin New(PD, Init(cdNormal,0));{Создаем диалоговое окно} Control := DeskTop^.ExecView(PD);{Используем окно} ChDir(PD^.DirInput^.Data^);{Устанавливаем новый каталог} Dispose(PD, Done){Удаляем окно из кучи} end;
Procedure TNotebook.DOSCall; {Временный выход в ДОС} const txt ='Для возврата введите EXIT в ответ'+' на приглашение ДОС...'; begin DoneEvents;{Закрыть обработчик событий} DoneVideo;{Закрыть монитор экрана} DoneMemory;{Закрыть монитор памяти} SetMemTop(HeapPtr) ;{Освободить кучу} WriteLn(txt);{Сообщить о выходе} SwapVectors;{Установить стандартные векторы} {Передать управление командному процессору ДОС:} Exec(GetEnv('COMSPEC'),''); {Вернуться из ДОС:} SwapVectors; {Восстановить векторы) SetMemTop(HeapEnd); {Восстановить кучу} InitMemory; {Открыть монитор памяти} InitVideo;{Открыть монитор экрана} InitEvents;{Открыть обработчик событий} InitSysError;{Открыть обработчик ошибок} Redraw {Восстановить вид экрана} end;
Procedure TNotebook.Work;{Работа с данными} var R: TRect; PW: PWorkWin; begin R.Assign(0,0,80,23) ; PW := New(PWorkWin, Init®); DeskTop^.Insert(PW) end; {Work}
Constructor TWorkWin.Init(Bounds: TRect);{Создание окна данных} var HS,VS: PScrollBar; {Полосы-указатели} Interior: PScroller; {Указатель на управляемое текстовое окно} begin TWindow.Init(Bounds,'',0); {Создаем новое окно с рамкой} GetClipRect(Bounds);{Получаем в BOUNDS координаты минимальной перерисовываемой части окна} Bounds.Grow(-1,-1);{Устанавливаем размеры окна с текстом} {Включаем стандартные по размеру и положению полосы-указатели:} VS := StandardScrollBar(sbVertical+sbHandleKeyBoard); HS := StandardScrollBar(sbHorizontal+sbHandleKeyBoard); {Создаем текстовое окно:} Interior := New(PScroller,Init(Bounds, HS, VS)); Insert(Interior) {Включаем его в основное окно} end;
Procedure TInterior.ReadFile;{Читает содержимое файла данных в массив Lines} var k: Integer; s: String; Data: DataType; f: text; begin PS := New(PStringCollection, Init(100,10)); s := copy(ParamStr(0),1,pos('.',ParamStr(0)))+'pas'; assign(f,s); reset (f); {Открыть файл с текстом программы} while not (EOF(f) or LowMemory) do begin ReadLn(f,s); if s <> ' ' then PS^.Insert(NewStr(s)) end; Close(f); exit; Seek(DataFile,0); while not (EOF(DataFile) or LowMemory) do begin Read(DataFile, data); with data do begin end; if s<>''then PS^.Insert(NewStr(s)) end; Location:=0; end; {ReadFile}
Procedure TInterior.Draw; {Выводит данные в окно просмотра} var n,k: Integer; B: TDrawBuffer; P: PString; Color: Byte; begin if Delta.Y > Location then Location := Delta.Y; if Location > Delta.Y+pred(Size.Y) then Location := Delta.Y+pred(Size.Y); for n := 0 to pred(Size.Y) do begin k := Delta.Y+n; if k=Location then Color := GetColor(2) else Color := GetColor(1); end end; {TInterior.Draw}
Constructor TInterior.Init(var Bounds: TRect; HS,VS: PScrollBar); begin SetLimit(LLine,PS^.Count) end; {TInterior.Init}
var Notebook: TNotebook; begin Notebook. Init;{Подготовить работу программы} Notebook. Run;{Выполнить необходимые действия} Notebook. Done{Завершить исполнение программы} end .