Не читает файл Опции

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

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

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

Сообщение отредактировано: Федосеев Павел - 1.09.2012 21:49

[TarasBer]

Есть такой глюк, что перед Reset надо делать сброс IOResult, иначе там не то будет выдаваться
Короче, получается так:

Assign(f, filename);
IOResult; // сброс
Reset(f);
if IOResult=0 then begin...

[Федосеев Павел]

Есть такой глюк, что перед Reset надо делать сброс IOResult, иначе там не то будет выдаваться

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

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

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



Сообщение отредактировано: Федосеев Павел - 1.09.2012 21:40

[GrukhvinEV]

Спасибо всем. Плохо я пока разбираюсь, много чего не понимаю.