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:=New(PInputLine,

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(New(PButton, Init(R, 'Выход',cmCancel,bfNormal)));

SelectNext(False) {Активизируем 1-ую кнопку}

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 ['а' 'п'] then

s[k]:=chr(ord('A')+ord(s[k])-ord('a'))

else if s[k] in ['р' 'я'] 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, 'Введите образец поиска:',p)));

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,bfNormal)));

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+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; {TInterior.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( {первый эл-т}

'~~ Открыть','F3',kbF3,cmOpen,hcNoContext,

NewItem( {второй эл-т}

'~~ Закрыть','F2',kbF2,cmSave,hcNoContext,

NewItem( {третий эл-т}

'~~ Сменить диск','',0,cmChangeDir,hcNoContext,

NewLine( {строка-разделитель}

NewItem('~~ Вызов ДОС','',0,cmDOSShell,hcNoContext,

NewItem('~~ Конец работы','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~ Выход',kbAltX,cmQuit,

NewStatusKey('~F2~ Закрыть',kbF2,cmSave,

NewStatusKey('~F3~ Открыть',kbF3,cmOpen,