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 .