{─ы ъюЁЁхъЄэющ ЁрсюЄ√ яЁюуЁрьь√ Їрщы phone.dat фюыцхэ эрїюфшЄ№ё т ърЄрыюух Phone, ъюЄюЁ√щ т ётю■ юўхЁхф№ фюыцхэ эрїюфшЄё т ърЄрыюух уфх єёЄрэютыхэ ч√ъ яЁюуЁрььшЁютрэш Turbo Pascal}
program Phonebook; uses Crt; type Phone = record SurnameS : string[15]; NameS : string[15]; PhoneS : string[15]; AddressS: string[50]; end; var PhoneF : file of Phone; PhoneR : Phone; a : array[1..600] of Phone; procedure WritePhone; begin Assign(PhoneF,'Phone\phone.dat'); Reset(PhoneF); ClrScr; writeln('┬ёх чряшёш:'); writeln; while not Eof(PhoneF) do begin PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; read(PhoneF,PhoneR); writeln; write(PhoneR.SurnameS); write(' ',PhoneR.NameS); write('',PhoneR.PhoneS); write('',PhoneR.AddressS); end; Close(PhoneF); writeln; writeln; write('═рцьшЄх ы■сє■ ъыртш°є...'); ReadKey; end; procedure AddPhone; begin Assign(PhoneF,'Phone\phone.dat'); Reset(PhoneF); while not Eof(PhoneF) do Read(PhoneF,PhoneR); PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; ClrScr; writeln('─юсртыхэшх чряшёш:'); writeln; Write('┬тхфшЄх ╘рьшыш■:'); readln(PhoneR.SurnameS); write('┬тхфшЄх ╚ь :'); readln(PhoneR.NameS); write('┬тхфшЄх эюьхЁ ЄхыхЇюэр:'); readln(PhoneR.PhoneS); write('┬тхфшЄх рфЁхё:'); readln(PhoneR.AddressS); write(PhoneF,PhoneR); Close(PhoneF); writeln; writeln('╟ряшё№ єёях°эю фюсртыхэр т срчє!!!'); writeln; write('═рцьшЄх ы■сє■ ъыртш°є...'); ReadKey; end; procedure DeletePhone; var temp : file of Phone; Nazv : string[15]; begin Assign(PhoneF,'Phone\phone.dat'); Reset(PhoneF); Assign(temp,'Phone\temp.dat'); Rewrite(temp); PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; ClrScr; writeln('╙фрыхэшх чряшёш:'); writeln; Write('┬тхфшЄх ╘рьшыш■:'); readln(Nazv); while not Eof(PhoneF) do begin Read(PhoneF,PhoneR); if PhoneR.SurnameS<>Nazv then Write(temp,PhoneR); end; Close(temp); Close(PhoneF); Erase(PhoneF); Rename(temp,'Phone\phone.dat'); writeln; writeln('╟ряшё№ єёях°эю єфрыхэр шч срч√!!!'); writeln; write('═рцьшЄх ы■сє■ ъыртш°є...'); ReadKey; end; procedure EditPhone; var Nazv : string[15]; temp : file of Phone; begin Assign(PhoneF,'Phone\phone.dat'); Reset(PhoneF); Assign(temp,'Phone\temp.dat'); Rewrite(temp); PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; ClrScr; writeln('╨хфръЄшЁютрэшх чряшёш:'); writeln; Write('┬тхфшЄх ╘рьшыш■, ъюЄюЁє■ їюЄшЄх шчьхэшЄ№:'); readln(Nazv); while not Eof(PhoneF) do begin PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; Read(PhoneF,PhoneR); if PhoneR.SurnameS<>Nazv then Write(temp,PhoneR); end; writeln; write('┬тхфшЄх эютє■ ╘рьшыш■:'); readln(PhoneR.SurnameS); write('┬тхфшЄх эютюх ╚ь :'); readln(PhoneR.NameS); write('┬тхфшЄх эют√щ эюьхЁ ЄхыхЇюэр:'); readln(PhoneR.PhoneS); write('┬тхфшЄх эют√щ рфЁхё:'); readln(PhoneR.AddressS); write(temp,PhoneR); Close(temp); Close(PhoneF); Erase(PhoneF); Rename(temp,'Phone\phone.dat'); writeln; writeln('╟ряшё№ єёях°эю шчьхэхэр!!!'); writeln; write('═рцьшЄх ы■сє■ ъыртш°є...'); ReadKey; end; procedure FindSurname; var Nazv : string[15]; k : integer; begin k:=0; Assign(PhoneF,'Phone\phone.dat'); Reset(PhoneF); ClrScr; writeln('╧юшёъ чряшёш яю ╘рьшышш:'); writeln; Write('┬тхфшЄх ╘рьшыш■:'); readln(Nazv); while not Eof(PhoneF) do begin PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; read(PhoneF,PhoneR); if PhoneR.SurnameS=Nazv then begin writeln; write(PhoneR.SurnameS); write(' ',PhoneR.NameS); write('',PhoneR.PhoneS); write('',PhoneR.AddressS); k:=k+1; end; end; Close(PhoneF); writeln; writeln; writeln('╧юшёъ чртхЁ°хэ, эрщфхэю чряшёхщ: ',k); writeln; write('═рцьшЄх ы■сє■ ъыртш°є...'); ReadKey; end; procedure FindPhone; var Nazv : string[15]; k : integer; begin k:=0; Assign(PhoneF,'Phone\phone.dat'); Reset(PhoneF); ClrScr; writeln('╧юшёъ чряшёш яю эюьхЁє ЄхыхЇюэр:'); writeln; Write('┬тхфшЄх эюьхЁ ЄхыхЇюэр:'); readln(Nazv); while not Eof(PhoneF) do begin PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; read(PhoneF,PhoneR); if PhoneR.PhoneS=Nazv then begin writeln; write(PhoneR.SurnameS); write(' ',PhoneR.NameS); write('',PhoneR.PhoneS); write('',PhoneR.AddressS); k:=k+1; end; end; Close(PhoneF); writeln; writeln; writeln('╧юшёъ чртхЁ°хэ, эрщфхэю чряшёхщ: ',k); writeln; write('═рцьшЄх ы■сє■ ъыртш°є...'); ReadKey; end; procedure SortSurname; var i,j,c: integer; tr: Phone; begin c:=0; Assign(PhoneF,'Phone\phone.dat'); Reset(PhoneF); ClrScr; writeln('╤юЁЄшЁютър яю ╘рьшышш:'); writeln; while not Eof(PhoneF) do begin inc(c,1); read(PhoneF,a[c]); end; for i:=1 to c do for j:=1 to c-1 do begin if a[j].SurnameS>a[j+1].SurnameS then begin tr:=a[j+1]; a[j+1]:=a[j]; a[j]:=tr; end; end; for i:=1 to c do begin writeln; write(a[i].SurnameS); write(' ',a[i].NameS); write('',a[i].PhoneS); write('',a[i].AddressS); end; Close(PhoneF); writeln; writeln; write('═рцьшЄх ы■сє■ ъыртш°є...'); ReadKey; end; procedure SortAddress; var i,j,c: integer; tr: Phone; begin c:=0; Assign(PhoneF,'Phone\phone.dat'); Reset(PhoneF); ClrScr; writeln('╤юЁЄшЁютър яю рфЁхёє:'); writeln; while not Eof(PhoneF) do begin inc(c,1); read(PhoneF,a[c]); end; for i:=1 to c do for j:=1 to c-1 do begin if a[j].AddressS>a[j+1].AddressS then begin tr:=a[j+1]; a[j+1]:=a[j]; a[j]:=tr; end; end; for i:=1 to c do begin writeln; write(a[i].SurnameS); write(' ',a[i].NameS); write('',a[i].PhoneS); write('',a[i].AddressS); end; Close(PhoneF); writeln; writeln; write('═рцьшЄх ы■сє■ ъыртш°є...'); ReadKey; end; procedure SortPhone; var i,j,c: integer; tr: Phone; begin c:=0; Assign(PhoneF,'Phone\phone.dat'); Reset(PhoneF); ClrScr; writeln('╤юЁЄшЁютър яю рфЁхёє:'); writeln; while not Eof(PhoneF) do begin inc(c,1); read(PhoneF,a[c]); end; for i:=1 to c do for j:=1 to c-1 do begin if a[j].PhoneS>a[j+1].PhoneS then begin tr:=a[j+1]; a[j+1]:=a[j]; a[j]:=tr; end; end; for i:=1 to c do begin writeln; write(a[i].SurnameS); write(' ',a[i].NameS); write('',a[i].PhoneS); write('',a[i].AddressS); end; Close(PhoneF); writeln; writeln; write('═рцьшЄх ы■сє■ ъыртш°є...'); ReadKey; end;
procedure SortType; var b: integer; begin repeat begin ClrScr; writeln('"╥хыхЇюээ√щ ёяЁртюўэшъ" - ьхэ■ ёюЁЄшЁютъш'); writeln; writeln('1. ═х ёюЁЄшЁютрЄ№'); writeln('2. ╤юЁЄшЁютрЄ№ яю ╘рьшышш'); writeln('3. ╤юЁЄшЁютрЄ№ яю рфЁхёє'); writeln('4. ╤юЁЄшЁютрЄ№ яю эюьхЁє ЄхыхЇюэр'); writeln('----------------------------'); writeln('5. ┬ючтЁрЄ т уыртэюх ьхэ■'); writeln; write('┬√схЁшЄх яєэъЄ ьхэ■: '); readln(b); case b of 1 : WritePhone; 2 : SortSurname; 3 : SortAddress; 4 : SortPhone; end; end; until b=5; end; procedure PhoneMenu; var b: integer; begin repeat begin ClrScr; writeln('"╥хыхЇюээ√щ ёяЁртюўэшъ" - ├ыртэюх ьхэ■'); writeln; writeln('1. ╧юърчрЄ№ тёх чряшёш'); writeln('2. ─юсртшЄ№ чряшё№'); writeln('3. ╙фрышЄ№ чряшё№'); writeln('4. ╨хфръЄшЁютрЄ№ чряшё№'); writeln('5. ╧юшёъ яю ╘рьшышш'); writeln('6. ╧юшёъ яю эюьхЁє ЄхыхЇюэр'); writeln('----------------------------'); writeln('7. ┬√їюф'); writeln; write('┬√схЁшЄх яєэъЄ ьхэ■: '); readln(b); case b of 1 : SortType; 2 : AddPhone; 3 : DeletePhone; 4 : EditPhone; 5 : FindSurname; 6 : FindPhone; end; end; until b=7; end; begin ClrScr; PhoneMenu; end.
Program Notebook; {Прогр мм обслужив ет ф йлы д нных "з писной книжки"} 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. Он созд ет скроллируемое окно с з писями из рхивного ф йл и с помощью ди логового окн TDlgWin упр вляет р ботой с этими з писями} 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 = 208; {Ред ктиров ть з пись} cmAdd = 209; {Доб вить з пись} {Множество временно недоступных ком нд:} 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); {Aн лизируем результ т з прoс :} 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); {?спользуем окно} ChDir(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, PS^.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(PStringCollection, Init(100,10)); seek(DataFile,0); while not (EOF(DataFile) or LowMemory) do begin Read(DataFile, 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 s<>'' then PS^.Insert(NewStr(S)) end; Location := 0; end; {ReadFile} {-------------------} Procedure TInterior.Draw; {Выводит д нные в окно просмотр } var n, {Текущ я строк экр н } k: Integer; {Текущ я строк м ссив } B: 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); MoveChar(B,' ',Color,Size.X); if k < pred(PS^.Count) then begin p := PS^.At(k); MoveStr(B, Copy(p^,Delta.X+1,Size.X),Color); end; WriteLine(0,N,Size.X,1,B) end end; {TInterior.Draw} {-------------------} Function Control: Word; {Получ ет ком нду из основного ди логового окн } const X = 1; L = 12; DX= 13; But: array [0..4] of String [13] = {Н дписи н кнопк х:} ('~1~ Выход ','~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,bfNormal))) 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 AddItem(Edit: Boolean); {Доб вляет новый или ред ктирует ст рый элемент д нных} const y = 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 := 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) {Активизируем первую кнопку} 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('А')+ord(s[k])-ord(' ')) else if s[k] in ['р'..'я'] then s[k] := chr(ord('Р')+ord(s[k])-ord('р')); 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) 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; {TInterior.HandleEvent} {------------------} Procedure TNotebook.Work; {Р бот с д нными} var R: TRect; PW: PWorkWin; Control: Word; begin R.Assign(0,0,80,23); PW := New(PWorkWin, Init®); 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.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; {TNotebook.InitMenuBar} {------------------} Procedure TNotebook.InitStatusLine; {Формирует строку ст тус } var R: TRect; {Гр ницы строки ст тус } begin GetExtent®; {Получ ем в 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.