1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 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 .
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. Прикладываю его в аттаче.
Есть такой глюк, что перед Reset надо делать сброс IOResult, иначе там не то будет выдаваться
Полагаю, что для fpc это было бы исправлено, а для tp - широко известно. В любом случае, исходники fpc и tp7 открыты - можно проверить реализацию reset и при наличии ошибки устранить глюк.
А по теме топика, у автора "слегка" запутано использования объектов TurboVision (FreeVision).
Моё раннее сообщение о затирании данных в файле, несомненно ошибочно.