IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Не читает файл
GrukhvinEV
сообщение 1.09.2012 5:34
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 21
Пол: Мужской

Репутация: -  0  +


При открытии файла 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 .
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 7.09.2025 17:07
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"