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,
NewStatusKey('~F4~ Работа',kbF4,cmWork,
NewStatusKey('~F10~ Меню',kbF10,cmMenu,
NIL))))), {нет других клавиш}
NIL) {нет др. определений}
));
DisableCommands(WinCom1) {запрещает недоступные команды}
end; {TNotebook.InitStatusLine}
{-----------------}
var
Nbook: TNotebook;
begin
Nbook.Init;
Nbook.Run;
Nbook.Done
end.