Программа Notebook
Описание программы см. п.. 15.
Program Notebook;
{Программа обслуживает файлы данных "записной книжки". Описание программы см. в гл.15}
Uses App, Objects, Menus, Drivers, Views, StdDlg,
DOS, Memory, Dialogs; type
{Объект TWorkWin создает рамочное окно с полосами скроллинга для управления встроенным в него объектом TInterior}
PWorkWin =TWorkWin;
TWorkWin = object (TWindow)
Constructor Init(Bounds: TRect);
end;
{Объект TDlgWin создает диалоговое окно для
выбора режима работы}
PDlgWin =TDlgWin;
TDlgWin = object (TDialog)
Procedure HandleEvent(var Event: TEvent); Virtual;
end;
{Следующий объект обслуживает внутреннюю часть рамочного
окна TWorkWin. Он создает скроллируемое окно с записями из
архивного файла и с помощью диалогового окна TDlgKin
управляет работой с этими записями}
PInterior =TInterior;
TInterior = object (TScroller)
PS: PStringCollection;
Location: Word;
Constructor Init(var Bounds: TRect; HS,VS: PScrollBar);
Procedure Draw; Virtual;
Procedure ReadFile;
Destructor Done; Virtual;
Procedure HandleEvent(var Event: TEvent); Virtual;
end;
{Объект-программа TNotebook поддерживает работу с меню и
строкой статуса}
TNotebook = object (TApplication)
Procedure InitStatusLine; Virtual;
Procedure InitMenuBar; Virtual;
Procedure HandleEvent(var Event: TEvent); Virtual;
Procedure FileSave;
Procedure ChangeDir;
Procedure DOSCall;
Procedure FileOpen;
Procedure Work;
end;
const
{Команды для обработчиков событий:}
cmChDir = 202; {Сменить каталог}
cmWork = 203; {Обработать данные}
cmDOS= 204; {Временно выйти в ДОС}
cmCan= 205; {Команда завершения работы}
cmDelete= 206; {Уничтожить текущую запись}
cmSearch = 207;{Искать нужную запись}
cmEdit = 209;{Редактировать запись}
cmAdd = 208;{Добавить запись}
{Множество временно недоступных команд:}
WinCom1: TCommandSet = [cmSave,cmWork];
WinCom2: TCommandSet = [cmOpen];
LName = 25; {Длина поля Name}
LPhone= 11; {Длина поля Phone}
LAddr =40; {Длина поля Addr}
LLine = LName+LPhone+LAddr; {Длина строки}
type
DataType = record {Тип данных в файле}
Name : String [LName]; {Имя}
Phone: String [LPhone]; {Телефон}
Addr : String [LAddr] {Адрес}
end;
var
DataFile: file of DataType; {Файловая переменная}
OpFileF : Boolean; {Флаг открытого файла}
{-----------------------}
Реализация объекта TWorkWin
{-----------------------}
Constructor TWorkWin.Init(Bounds: TRect);
{Создание окна данных}
var
HS,VS: PScrollBar; {Полосы-указатели}
Interior: PInterior; {Указатель на управляемое текстовое окно}
begin
TWindow.Init(Bounds,0);{Создаем новое окно с рамкой}
GetClipRect(Bounds); {Получаем в BOUNDS координаты минимальной перерисовываемой части окна}
Bounds.Grow(-1,-1);{Устанавливаем размеры окна с текстом}
{Включаем стандартные по размеру и положению полосы-указатели:}
VS := StandardscrollBar (sbVertical+sbHandleKeyBoard) ;
HS := StandardscrollBar (SbHorizontal+sbHandleKeyBoard) ;
{Создаем текстовое окно:}
Interior := New (PInterior, Init (Bounds, HS, VS) ) ;
Insert (Interior) {Включаем его в основное окно}
end; {TWorkWin.Init}
{----------------------}
Procedure TDlgWin.HandleEvent;
begin
Inherited HandleEvent (Event) ;
if Event. What=evCommand then
EndModal (Event. Command)
end;
{-----------------}
Procedure TNotebook.FileOpen;
{Открывает файл данных}
var
PF: PFileDialog; {Диалоговое окно выбора файла}
Control: Word;
s: PathStr;
begin
{Создаем экземпляр динамического объекта:}
New(PF, Init('*.dat','Выберите нужный файл:',
'Имя файла',fdOpenButton,0))
{С помощью следующего оператора окно выводится на экран
и результат работыпользователя с ним помещается в переменную
Control:}
Control := DeskTop.ExecView(PF);
{Анализируем результат запроса:}
case Control of
StdDlg.cmFileOpen,cmOk:
begin {Пользователь указал имя файла:}
PF.GetFileName(s); {s содержит имя файла}
Assign(DataFile,s);
{$I-}
Reset(DataFile) ;
if IOResult <> 0 then
Rewrite(DataFile);
OpFileF := IOResult=0;
{$I+}
if OpFileF then
begin
DisableCommands(WinCom2);
EnableCommands(WinCom1);
Work {Переходим к работе}
end
end;
end; {case Control}
Dispose(PF, Done) {Уничтожаем экземпляр}
end; {FileOpen}
{-----------------}
Procedure TNotebook.FileSave; { Закрывает файл данных} begin
Close(DataFile);
OpFileF := False;
EnableCommands(WinCom2); {Разрешаем открыть файл)
DisableCommands(WinCom1) {Запрещаем работу и сохранение}
end; {TNotebook.FileSave}
{------------------}
Procedure TNotebook.ChangeDir;
{Изменяет текущий каталог}
var
PD: PChDirDialog; {Диалоговое окно смены каталога/диска}
Control: Word; begin
New(PD, Init(cdNormal,0)); {Создаем диалоговое окно}
Control := DeskTop.ExecView(PD); {Используем окно}
Choir(PD.DirInput.Data); {Устанавливаем новый каталог}
Dispose(PD, Done) {Удаляем окно из кучи}
end; {TNotebook.ChangeDir}
{---------------------}
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; {DOSCall}
{---------------}
Constructor TInterior.Init;
{Создает окно скрроллера}
begin
TScroller.Init(Bounds, Hs, VS);
ReadFile;
GrowMode := gfGrowHiX+gfGrowHiY;
SetLimit(LLine, РS.Count)
end;
{--------------}
Destructor TInterior. Done;
begin
Dispose (PS, Done) ;
Inherited Done
end ;
{--------------}
Procedure TInterior. ReadFile;
{Читает содержимое файла данных в массив LINES}
var
k: Integer;
s: String;
Data: DataType;
f: text;
begin
PS := New(PStringGollection, Init (100, 10) );
seek(DataFile,0) ;
while not (EOF(DataFile) or LowMemory) do
begin
ReadfDataFile, data) ;
with data do
begin
s : = Name ;
while Length (s) < LName do
s : = s+ ' ' ;
s := s+Phone;
while Length (s) < LName+LPhone do
s : = s+ ' ' ;
s := s+Addr
end;
if so'' then PS. insert (NewStr (S) )
end;
Location := 0;
end; {ReadFile}
{-----------}
Procedure TInterior.Draw;
{ Выводит данные в окно просмотра}
var
n, {Текущая строка экрана}
k: Integer; {Текущая строка массива}
В: TDrawBuffer;
Color: Byte;
p: PString;
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
{Size. Y - количество строк окна}
begin
k := Delta. Y+n;
if k=Location then
Color := GetColor(2)
else
Color := GetColor(1);
MoveCharfB,' ', Color, Size. X) ;
if k < pred(PS. count) then
begin
p := PS.At(k) ;
MoveStr(B, Copy (р, Delta. X+1, Size. X) , Color) ;
end;
WriteLine(0,N,Size.X,1,B)
end
end; {Tlnterior.Draw}
{---------------}
Function Control: Word;
{ Получает команду из основного диалогового окна}
const X = 1;
L = 12;
DX= 13;
But: array [0..4] of String [13] = {Надписи на кнопках:}
('~l~ Выход ' , ' ~2~ Убрать ','~3~ Искать ','~4~ Изменить ','~5~ Добавить');
Txt: array [0..3] of String [52] = (
{Справочный текст:}
'Убрать - удалить запись, выделенную цветом ',
'Искать - искать запись, начинающуюся нужными буквами',
'Изменить - изменить поле (поля) выделенной записи',
'Добавить - добавить новую запись');
var
R: TRect;
D: PDlgWin;
k: Integer;
begin
R.Assign(7,6,74,15) ;
D := New (PDlgWin, Init (R, 'Выберите продолжение:'));
with D do begin
for k := 0 to 3 do{Вставляем поясняющий текст}
begin
R.Assign(1,1+k,65,2+k) ;
Insert (New(PStaticText, Init (R,#3+Txt [k] ) ) )
end;
for k := 0 to 4 do {Вставляем кнопки:}
begin
R.Assign(X+k*DX,6,X+k*DX+L,8) ;
Insert (New (PButton, Init(R,But [k] ,cmCan+k,bf Normal) ) )
end;
SelectNext (False) ; {Активизируем первую кнопку}
end;
Control := DeskTop.ExecView(D) ; {Выполняем диалог}
end; {Control}
{-----------------}
Procedure TInterior.HandleEvent;
Procedure DeleteItem;
{Удаляет указанный в Location элемент данных}
var
D: Integer;
PStr: PString;
s: String;
Data: DataType;
begin
PStr := PS.At(Location); {Получаем текущую запись}
s := copy(PStr,1,LName);
seek(DataFile,0);
D := -1; {D - номер записи в файле}
repeat { Цикл поиска по совпадению поля Name:}
inc(D) ;
read(DataFile,Data);
with Data do while Length(Name) < LName do
Name := Name+' '
until Data.Name=s;
seek(DataFile,pred(FileSize(DataFile)));
read(DataFile,Data); {Читаем последнюю запись}
seek(DataFile,D);
write(DataFile,Data); {Помещаем ее на место удаляемой}
seek(DataFile,pred(Filesize(DataFile)));
truncate(DataFile); {Удаляем последнюю запись}
with PS do D := IndexOf(At(Location));
PS.AtFree(D); {Удаляем строку из коллекции}
Draw {Обновляем окно}
end; {DeleteItem}
{-------------}
Procedure AddItemfEdit: Boolean);
{Добавляет новый или редактирует старый элемент данных}
const у = 1;
dy= 2;
L = LName+LPhone+LAddr;
var
Data: DataType;
R: TRect;
InWin: PDialog;
BName,BPhone,BAddr: PInputLine;
Control: Word;
OldCount: Word;
s: String;
p: PString;
begin
Seek(DataFile,Filesize(DataFile));{Добавляем записи
в конец файла}
repeat {Цикл ввода записей}
if Edit then {Готовим заголовок}
s := 'Редактирование:'
else
begin
Str(Filesize(DataFile)+1,s);
while Length(s) < 3 do
s := '0'+s;
s := 'Вводится запись N '+s
end;
FillChar(Data,SizeOf(Data),' ');{Заполняем поля пробелами}
R.Assign(15,5,65,16);
InWin := New(PDialog, Init(R, s));{Создаем окно}
with InWin do
begin
R.Assign(2,y+1,2+LName,y+2); {Формируем окно:}
BName := New(PInputLine, Init(R,LName))
Insert(BName); {Поле имени}
R.Assign(2,y,2+LName,y+1) ;
Insert(New(PLabel, Init(R, 'Имя',BName)));
R.Assign(2,y+dy+1,2+LPhone,y+dy+2);
BPhone := NewtPInputLine, Init(R,LPhone));
Insert(BPhone); {Поле телефон}
R.Assign(2,y+dy,2+LPhone,y+dy+1);
Insert(New(PLabel, Init(R, 'Телефон',BPhone)));
R.Assign(2,y+2*dy+1,2+LAddr,y+2*dy+2) ;
BAddr := New(pinputLine, Init(R,LAddr));
Insert(BAddr); {Поле адреса}
R.Assign)2,y+2*dy,2+LAddr,y+2*dy+1);
Insert(New(PLabel, Init(R, 'Адрес',BAddr)));
{Вставляем две командные кнопки:}
R.Assign(2,y+3*dy+1,12,y+3*dy+3);
Insert(New(PButton, Init(R, 'Ввести',cmOK,bfDefault))) ;
R.Assign(2+20,y+3*dy+1,12+20,y+3*dy+3) ;
Insert(NewfPButton, Init(R, 'Выход',cmCancel,bfNormal)
SelectNext(False) {Активизируем первую кнопку}
end; {Конец формирования окна}
if Edit then with Data do
begin {Готовим начальный текст:}
p := PS.At(Location); {Читаем данные из записи}
s := p;
Name := copy(s,1,LName);
Phone:= copy(s,succ(LName),LPhone);
Addr := copy(s,succ(LName+LPhone),LAddr);
InWin.setData(Data) {Вставляем текст в поля ввода}
end;
Control := DeskTop.ExecView(InWin); {Выполняем диалог}
if Control=cmOk then with Data do
begin
if Edit then
DeleteItem; { Удаляем старую запись}
Name := BName.Data;
Phone:= BPhone.Data;
Addr := BAddr.Data;
s[0] := chr(L) ;
FillChar(s [1] , L, ' ') ;
move (Name [1] ,s [1] ,Length (Name)) ;
move(Phone[1],s[succ(LName)],Length(Phone));
move(Addr[1],s[succ(LName+LPhone)],Length(Addr)
OldCount := PS. Count; {Прежнее количество записей}
PS . Insert (NewStr (s) ) ; {Добавляем в коллекцию}
{Проверяем добавление }
if OldCount <> PS. Count then
Write (DataFile, Data) {Да - добавляем в файл}
end
until Edit or (Control=cmCancel) ;
Draw
end; {AddItem}
{-----------------}
Procedure SearchItem;
{Ищет нужный элемент}
Function UpString(s: String): String;
{Преобразует строку в верхний регистр}
var
k: Integer;
begin
for k := 1 to Length(s) do
if s[k] in ['a'..'z'] then
s[k] := chr(ord('A')+ord(s [k] ) -ord('a') )
else if s[k] in ['a'..'n'] then
s[k]:= chr(ord('A')+ord(s[k] )-ord('a') )
else if s[k] in ['p'..'я'] then
s[k] := chr(ord('P')+ord(s [k] ) -ord('p') )
UpString := s
end; {UpString}
var
InWin: PDialog;
R: TRect;
s: String;
p: PInputLine;
k: Word;
begin {SearchItem}
R.Assign(15,8,65,16) ;
InWin := New (PDialog, Init (R, 'Поиск записи:'))
with InWin do
begin
R.Assign(2,2,47,3) ;
p := New (PInputLine,Init(R,50));
Insert (p) ; R.Assign(1,1,40,2) ;
Insert (New (PLabel, Init(R,'Введите образец для поиска:',р)));
R.Assign(10,5,20,7) ;
Insert (New (PButton,Init(R,'Ввести',cmOk,bfDefault)));
R.Assign(25,5,35,7) ;
Insert (New (PButton,Init (R,' Выход' ,cmCancel,bf Normal)));
SelectNext (False)
end;
if DeskTop.ExecView(InWin) = cmCancel then
exit; s :=p.Data;
Location := 0;
while (UpString(s) >= UpString (PString(PS. At (Location))))
and (Location < pred(PS. Count) ) do
inc (Location) ;
if (Location < Delta.Y) or (Location > Delta.Y+pred(Size.Y)) then
ScrollTo (Delta.X, Location)
else
Draw
end; {SearchItem}
{-----------------}
var
R: TPoint;
label Cls;
begin
TScroller. HandleEvent (Event) ;
case Event. What of
evCommand :
case Event.Command of
cmClose:
begin
Cls:
case Control of { Получить команду из основного диалогового окна}
cmCan,
cmCancel: EndModal (cmCancel) ;
cmEdit : AddItem(True) ;
cmDelete: DeleteItem;
cmSearch: SearchItem;
cmAdd : AddItem(False);
end
end;
cmZoom: exit;
end;
evMouseDown: {Реакция на щелчок мышью}
begin
MakeLocal(MouseWhere, R);{Получаем в R локальные координаты указателя мыши}
Location := Delta.Y+R.Y;
Draw
end;
evKeyDown: {Реакция на клавиши + -}
case Event.KeyCode of
kbEsc: goto Cls;
kbGrayMinus: if Location > Delta.Y then
begin
dec(Location); Draw
end;
kbGrayPlus: if Location < Delta.Y+pred(Size.Y)then
begin
inc(Location);
Draw
end;
end
end
end; {Tlnterior.HandleEvent}
{------------------}
Procedure TNotebook.Work;
{Работа с данными}
var
R : TRect ;
PW : PWorkWin ;
Control: Word;
begin
R.Assign(0,0,80,23) ;
PW := New (PWorkWin, Init (R) ) ;
Control := DeskTop.ExecView(PW) ;
Dispose (PW, Done)
end;
{-------------------}
Procedure TNOtebook.HandleEvent (var Event: TEvent) ;
{Обработчик событий программы}
begin {TNOtebook.HandleEvent}
TApplication.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; {TNOtebook.HandleEvent}
{-------------}
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~/ Сменить диск1 , ' ' , 0, cmChangeDir, hcNoContext,
NewLine( {Строка-разделитель}
NewItem( '~4~/ Вызов ДОС' , ' ' , 0, cmDOSShell, hcNoContext,
NewItem( '~5~/ Конец работы' , 'Alt-X' , kbAltX, cmQuit,hcNoContext,
NIL)))))) {Нет других элементов подменю} ),
{Создаем второй элемент главного меню}
NewItem('~W~/ Работа', ' ', kbF4,cmWork, hcNoContext,
NIL) {Нет других элементов главного меню}
))))
end; {TNotebook. InitMenuBar}
{-----------------}
Procedure TNotebook. InitStatusLine;
{Формирует строку статуса}
var
R: TRect; {Границы строки статуса}
begin
GetExtent (R) ; {Получаем в R координаты всего экрана}
R.A.Y := pred(R.B.Y) ;
StatusLine := New(PStatusLine,
Init(R, {Создаем строку статуса}
NewStatusDef (0, $FFFF, {Устанавливаем максимальный диапазон контекстной справочной службы}
NewStatusKey('~Alt-X~ Выход1, kbAltX, cmQuit,
NewStatusKey(I~F2~ Закрыть', kbF2, cmSaveFile,
NewStatusKey ( '~F3~ Открыть', kbF3, cmOpenFile,
NewStatusKey ( '~F4~ Работа', kbF4, cmWork,
NewStatusKey ( '~F10~ Меню1, kbF10, craMenu,
NIL) ) ) ) ) , {Нет других клавиш}
NIL) {Нет других определений}
));
DisableCommands (WinCom1) {Запрещаем недоступные команды}
end; {TNotebook . InitStatusLine}
{------------------}
var
Nbook: TNotebook;
begin
Nbook. Init ;
Nbook. Run;
Nbook . Done
end.
