При открытии файла 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 .
Федосеев Павел
1.09.2012 20:40
Не плохо бы и сам файл ".dat" приложить...
Procedure TNotebook.FileOpen; {Открывает файл данных} begin {Создаем экземпляр динамического объекта:} ............ Assign(DataFile,s); {Отсюда начинаются новые строки} {$I-} Reset(DataFile); if IOResult <>0 then Rewrite(DataFile); <----- если файл открывается, то сотрём все записи в нём OpFileF := IOResult=0; {$I+} ................. end;
И ещё, мне кажется, что в программе нелады со структурой вызовов, объявлением глобальных переменных и использованием их внутри объекта.
Вот пример для объекта, аналогичного TNotebook. Он, конечно, не полный, но даёт представление о структуре вызовов и о зонах ответственности.
PROCEDURE TFileViewerApp.FileOpen( WildCard : PathStr); var D,E: PFileDialog; FileName : PathStr; begin { FileOpen } D := New(PFileDialog, Init(WildCard, 'Open a File', '~N~ame', fdOpenButton, 100)); if ValidView(D) <> nil then begin if Desktop^.ExecView(D) <> cmCancel then begin D^.GetFileName(FileName); ViewFile(FileName); end; Dispose(D, Done); end; END; { FileOpen } procedure TFileViewerApp.ViewFile(FileName: PathStr); var W: PWindow; begin W := New(PFileWindow,Init(FileName)); if ValidView(W) <> nil then Desktop^.Insert(W); end;
PROCEDURE TFileViewerApp.HandleEvent(var Event: TEvent); begin TApplication.HandleEvent(Event); case Event.What of evCommand: begin case Event.Command of cmFileOpen : FileOpen('*.*'); cmChangeDir : ChangeDir; ........................... else Exit; end; ClearEvent(Event); end; end; end;
далее идет наследник TWindow constructor TFileWindow.Init(var FileName: PathStr); var R: TRect; begin Desktop^.GetExtent( r); TWindow.Init(R, Filename, wnNoNumber); Options := Options or ofTileable; GetExtent( r); R.Grow(-1, -1); Insert(New(PFileViewer, Init(R, StandardScrollBar(sbHorizontal + sbHandleKeyboard), StandardScrollBar(sbVertical + sbHandleKeyboard), Filename))); end;
далее наследник TScroller constructor TFileViewer.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; var FileName: PathStr); var FileToView: Text; Line: String; MaxWidth: Integer; begin TScroller.Init(Bounds, AHScrollbar, AVScrollBar); GrowMode := gfGrowHiX + gfGrowHiY; IsValid := True; FileLines := New(PLineCollection, Init(5,5)); {$I-} Assign(FileToView, FileName); Reset(FileToView); if IOResult <> 0 then begin MessageBox('Cannot open file '+Filename+'.', nil, mfError + mfOkButton); IsValid := False; end else begin MaxWidth := 0; while not Eof(FileToView) and not LowMemory do begin Readln(FileToView, Line); if Length(Line) > MaxWidth then MaxWidth := Length(Line); FileLines^.Insert(NewStr(Line)); end; Close(FileToView); end; {$I+} SetLimit(MaxWidth, FileLines^.Count); end;
Как видишь, потомок TApplication (князей Бриндизи ) не утруждает себя чтением из файла, а отдаёт только имя файла наследнику TWindow, а тот тоже не перетрудится, а передаёт работу наследнику TScroller. Ну а последнему деваться некуда - прийдётся организовывать чтение и отображение.
Такой здоровый кусок кода я привёл ещё и для того, чтобы показать - все переменные, которые нужны для работы, находятся внутри обектов, а не объявлены как глобальные (например, имя файла, сама файловая переменная и т.д.)
Для TV есть много примеров отображения текстовых файлов. В своё время хорошо помог FileView из tp6. Прикладываю его в аттаче.
TarasBer
2.09.2012 0:23
Есть такой глюк, что перед Reset надо делать сброс IOResult, иначе там не то будет выдаваться Короче, получается так:
Assign(f, filename); IOResult; // сброс Reset(f); if IOResult=0 then begin...
Федосеев Павел
2.09.2012 1:31
Цитата(TarasBer @ 1.09.2012 20:23)
Есть такой глюк, что перед Reset надо делать сброс IOResult, иначе там не то будет выдаваться
Полагаю, что для fpc это было бы исправлено, а для tp - широко известно. В любом случае, исходники fpc и tp7 открыты - можно проверить реализацию reset и при наличии ошибки устранить глюк.
А по теме топика, у автора "слегка" запутано использования объектов TurboVision (FreeVision).
Моё раннее сообщение о затирании данных в файле, несомненно ошибочно.
GrukhvinEV
2.09.2012 15:01
Спасибо всем. Плохо я пока разбираюсь, много чего не понимаю.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.