Помощь - Поиск - Пользователи - Календарь
Полная версия: Не читает файл
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
GrukhvinEV
При открытии файла 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;

var
DataFile: file of DataType; {Файловая переменная}
OpFileF : Boolean; {Флаг открытого файла}
PF: PFileDialog; {Диалоговое окно выбора файла}
Control: Word;
s: PathStr;

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 .
Федосеев Павел
Не плохо бы и сам файл ".dat" приложить...


Procedure TNotebook.FileOpen; {Открывает файл данных}
begin {Создаем экземпляр динамического объекта:}
............
Assign(DataFile,s); {Отсюда начинаются новые строки}
{$I-}
Reset(DataFile);
if IOResult <>0 then Rewrite(DataFile); <----- если файл открывается, то сотрём все записи в нём
OpFileF := IOResult=0;
{$I+}
.................
end;



И ещё, мне кажется, что в программе нелады со структурой вызовов, объявлением глобальных переменных и использованием их внутри объекта.

Вот пример для объекта, аналогичного TNotebook. Он, конечно, не полный, но даёт представление о структуре вызовов и о зонах ответственности.

  PLineCollection = ^TLineCollection;
TLineCollection = object(TCollection)
procedure FreeItem(P: Pointer); virtual;
end;

PFileWindow = ^TFileWindow;
TFileWindow = object(TWindow)
constructor Init(var FileName: PathStr);
end;

PFileViewer = ^TFileViewer;
TFileViewer = object(TScroller)
FileLines: PCollection;
IsValid: Boolean;
constructor Init(var Bounds: TRect;
AHScrollBar,AVScrollBar: PScrollBar; var FileName: PathStr);
destructor Done; virtual;
procedure Draw; virtual;
function Valid(Command: Word): Boolean; virtual;
end;

PFileViewerApp = ^TFileViewerApp;
TFileViewerApp = object(TApplication)
constructor Init;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Idle; virtual;
procedure InitMenuBar; virtual;
procedure InitStatusLine; virtual;
procedure OutOfMemory; virtual;
procedure FileOpen(WildCard : PathStr);
procedure ViewFile(FileName : PathStr);
end;

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 (князей Бриндизи blink.gif ) не утруждает себя чтением из файла, а отдаёт только имя файла наследнику TWindow, а тот тоже не перетрудится, а передаёт работу наследнику TScroller. Ну а последнему деваться некуда - прийдётся организовывать чтение и отображение.

Такой здоровый кусок кода я привёл ещё и для того, чтобы показать - все переменные, которые нужны для работы, находятся внутри обектов, а не объявлены как глобальные (например, имя файла, сама файловая переменная и т.д.)

Для TV есть много примеров отображения текстовых файлов. В своё время хорошо помог FileView из tp6.
Прикладываю его в аттаче.
TarasBer
Есть такой глюк, что перед Reset надо делать сброс IOResult, иначе там не то будет выдаваться
Короче, получается так:

Assign(f, filename);
IOResult; // сброс
Reset(f);
if IOResult=0 then begin...
Федосеев Павел
Цитата(TarasBer @ 1.09.2012 20:23) *
Есть такой глюк, что перед Reset надо делать сброс IOResult, иначе там не то будет выдаваться


Полагаю, что для fpc это было бы исправлено, а для tp - широко известно. В любом случае, исходники fpc и tp7 открыты - можно проверить реализацию reset и при наличии ошибки устранить глюк.

А по теме топика, у автора "слегка" запутано использования объектов TurboVision (FreeVision).

Моё раннее сообщение о затирании данных в файле, несомненно ошибочно. wub.gif

GrukhvinEV
Спасибо всем. Плохо я пока разбираюсь, много чего не понимаю.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.