Помощь - Поиск - Пользователи - Календарь
Полная версия: ООП на Turbo Pascal
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
dron4ik
Всем привет. Возникла такая проблема...Дана задача написать телефонный справочник на Турбо Паскале принципом Объектного Ориентированного Программирования.(модульное программирование). у меня есть листинг программы...но проблема в том что программа написанна вроде не принципом Объектного Ориентированного Программирования а процедурным... я незнаю как перевести этот код в Объектно Ориентированное программирование(модульное программирование) т.е. к проге наверно должны быть привязаны модули.

Программа умеет добавлять, изменять, удалять, искать записи. Также, для упрощения работы с программой, создан интуитивно понятный интерфейс.В программе используется следующий алгоритм работы с данными: все данные хранятся в файле phone.dat и загружаются в программу при вызове той или иной процедуры. При удалении или изменении записи создается временный файл с именем temp.dat, в него записываются все данные из файла phone.dat кроме тех которые были удалены или записываются уже измененные данные, затем файл phone.dat удаляется, а файл temp.dat переименовывается в phone.dat.


{Для корректной работы программы файл 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.
volvo
Цитата
написать телефонный справочник на Турбо Паскале принципом Объектного Ориентированного Программирования.(модульное программирование)
Так модульное, или ООП? Это не одно и то же. "Модульное" - это разбиение программ на отдельные единицы компиляции - модули, но это не значит, что модули будут реализованы в виде объектов. Они можут быть реализованы и в виде отдельных процедур и функций.

P.S. Перенесено в раздел "Задачи".
dron4ik
Как я понял---> Мне нужно чтобы к основной программе были подключены модули...Каждый модуль как я понял считается подпрограмой..
Тоесть в основной проге как бы свой код, а в модулях свои..

Добавлено через 10 мин.
Т.е. выделение групп подпрограмм использующих одни и те же глобальные данные в отдельно компилируемые модули.
dron4ik
А как мне разбить на модули, которые реализованы ввиде объектов?
Ozzя
http://pascal-books.narod.ru/books/examples.zip
Рекомендую посмотреть пример телефонной книги от Фаронова
dron4ik
Спасибо). А он подходит к ООП?

Program Notebook;
{Џа(r)Ја ¬¬  (r)Ўб«г¦Ёў Ґв д (c)«л ¤ ­­ле "§ ЇЁб­(r)(c) Є­Ё¦ЄЁ"}
Uses App, Objects, Menus, Drivers, Views, StdDlg, DOS, Memory, Dialogs;
type

  {ЋЎкҐЄв TWorkWin б(r)§¤ Ґв а ¬(r)з­(r)Ґ (r)Є­(r) б Ї(r)«(r)б ¬Ё бЄа(r)««Ё­Ј 
   ¤«п гЇа ў«Ґ­Ёп ўбва(r)Ґ­­л¬ ў ­ҐЈ(r) (r)ЎкҐЄв(r)¬ TInterior}
  PWorkWin =^TWorkWin;
  TWorkWin = object (TWindow)
    Constructor Init(Bounds: TRect);
  end;

  {ЋЎкҐЄв TDlgWin б(r)§¤ Ґв ¤Ё «(r)Ј(r)ў(r)Ґ (r)Є­(r) ¤«п ўлЎ(r)а 
  ०Ё¬  а Ў(r)вл}
  PDlgWin =^TDlgWin;
  TDlgWin = object (TDialog)
    Procedure HandleEvent(var Event: TEvent); Virtual;
  end;

  {‘«Ґ¤гойЁ(c) (r)ЎкҐЄв (r)Ўб«г¦Ёў Ґв ў­гв७­оо з бвм а ¬(r)з­(r)Ј(r) (r)Є­ 
  TWorkWin. Ћ­ б(r)§¤ Ґв бЄа(r)««Ёа㥬(r)Ґ (r)Є­(r) б § ЇЁбп¬Ё Ё§
   аеЁў­(r)Ј(r) д (c)«  Ё б Ї(r)¬(r)ймо ¤Ё «(r)Ј(r)ў(r)Ј(r) (r)Є­  TDlgWin гЇа ў«пҐв
  а Ў(r)в(r)(c) б нвЁ¬Ё § ЇЁбп¬Ё}
  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;

  {ЋЎкҐЄв-Їа(r)Ја ¬¬  TNotebook Ї(r)¤¤Ґа¦Ёў Ґв а Ў(r)вг б ¬Ґ­о
  Ё бва(r)Є(r)(c) бв вгб }
  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
  {Љ(r)¬ ­¤л ¤«п (r)Ўа Ў(r)взЁЄ(r)ў б(r)ЎлвЁ(c):}
  cmChDir    = 202; {‘¬Ґ­Ёвм Є в «(r)Ј}
  cmWork     = 203; {ЋЎа Ў(r)в вм ¤ ­­лҐ}
  cmDOS      = 204; {‚६Ґ­­(r) ўл(c)вЁ ў „Ћ‘}
  cmCan      = 205; {Љ(r)¬ ­¤  § ўҐа襭Ёп а Ў(r)вл}
  cmDelete   = 206; {“­Ёзв(r)¦Ёвм ⥪гйго § ЇЁбм}
  cmSearch   = 207; {?бЄ вм ­г¦­го § ЇЁбм}
  cmEdit     = 208; {ђҐ¤ ЄвЁа(r)ў вм § ЇЁбм}
  cmAdd      = 209; {„(r)Ў ўЁвм § ЇЁбм}
  {Њ­(r)¦Ґбвў(r) ўаҐ¬Ґ­­(r) ­Ґ¤(r)бвгЇ­ле Є(r)¬ ­¤:}
  WinCom1: TCommandSet = [cmSave,cmWork];
  WinCom2: TCommandSet = [cmOpen];

  LName = 25; 			{„«Ё­  Ї(r)«п Name}
  LPhone= 11; 			{„«Ё­  Ї(r)«п Phone}
  LAddr = 40; 			{„«Ё­  Ї(r)«п Addr}
  LLine = LName+LPhone+LAddr;   {„«Ё­  бва(r)ЄЁ}
type
  DataType = record 		{’ЁЇ ¤ ­­ле ў д (c)«Ґ}
    Name : String[LName]; 	{?¬п}
    Phone: String[LPhone]; 	{’Ґ«Ґд(r)­}
    Addr : String[LAddr] 	{Ђ¤аҐб}
  end;
var
  DataFile: file of DataType;   {” (c)«(r)ў п ЇҐаҐ¬Ґ­­ п}
  OpFileF : Boolean; 		{”« Ј (r)вЄалв(r)Ј(r) д (c)« }

{-----------------------------------------
      ђҐ «Ё§ жЁп (r)ЎкҐЄв  TWorkWin
------------------------------------------}
Constructor TWorkWin.Init(Bounds: TRect);
{‘(r)§¤ ­ЁҐ (r)Є­  ¤ ­­ле}
var
  HS,VS: PScrollBar; 		{Џ(r)«(r)бл-гЄ § ⥫Ё}
  Interior: PInterior; 		{“Є § вҐ«м ­  гЇа ў«пҐ¬(r)Ґ ⥪бв(r)ў(r)Ґ (r)Є­(r)}
begin
  TWindow.Init(Bounds,'',0); 	{‘(r)§¤ Ґ¬ ­(r)ў(r)Ґ (r)Є­(r) б а ¬Є(r)(c)}
  GetClipRect(Bounds); 		{Џ(r)«гз Ґ¬ ў BOUNDS Є(r)(r)а¤Ё­ вл
  				¬Ё­Ё¬ «м­(r)(c) ЇҐаҐаЁб(r)ўлў Ґ¬(r)(c) з бвЁ (r)Є­ }
  Bounds.Grow(-1,-1);  		{“бв ­(r)ў«Ёў Ґ¬ а §¬Ґал (r)Є­  б ⥪бв(r)¬}
  {‚Є«оз Ґ¬ бв ­¤ ав­лҐ Ї(r) а §¬Ґаг Ё Ї(r)«(r)¦Ґ­Ёо Ї(r)«(r)бл-гЄ § ⥫Ё:}
  VS := StandardScrollBar(sbVertical+sbHandleKeyBoard);
  HS := StandardScrollBar(sbHorizontal+sbHandleKeyBoard);
  {‘(r)§¤ Ґ¬ ⥪бв(r)ў(r)Ґ (r)Є­(r):}
  Interior := New(PInterior,Init(Bounds, HS, VS));
  Insert(Interior)              {‚Є«оз Ґ¬ ҐЈ(r) ў (r)б­(r)ў­(r)Ґ (r)Є­(r)}
end; {TWorkWin.Init}
{-----------------}
Procedure TDlgWin.HandleEvent;
begin
  Inherited HandleEvent(Event);
  if Event.What=evCommand then
    EndModal(Event.Command)
end;
{------------------}
Procedure TNotebook.FileOpen;
{ЋвЄалў Ґв д (c)« ¤ ­­ле}
var
  PF: PFileDialog; {„Ё «(r)Ј(r)ў(r)Ґ (r)Є­(r) ўлЎ(r)а  д (c)« }
  Control: Word;
  s: PathStr;
begin
  {‘(r)§¤ Ґ¬ нЄ§Ґ¬Ї«па ¤Ё­ ¬ЁзҐбЄ(r)Ј(r) (r)ЎкҐЄв :}
  New(PF, Init('*.dat','‚лЎҐаЁвҐ ­г¦­л(c) д (c)«:',
					'?¬п д (c)« ',fdOpenButton,0));
  {‘ Ї(r)¬(r)ймо б«Ґ¤го饣(r) (r)ЇҐа в(r)а  (r)Є­(r) ўлў(r)¤Ёвбп ­  нЄа ­
	Ё १г«мв в а Ў(r)вл Ї(r)«м§(r)ў ⥫п б ­Ё¬ Ї(r)¬Ґй Ґвбп ў
	ЇҐаҐ¬Ґ­­го   Control:}
  Control := DeskTop^.ExecView(PF);
  {A­ «Ё§Ёа㥬 १г«мв в § Їаoб :}
  case Control of
    StdDlg.cmFileOpen,cmOk:
      begin         		{Џ(r)«м§(r)ў ⥫м гЄ § « Ё¬п д (c)« :}
        PF^.GetFileName(s); 	{s б(r)¤Ґа¦Ёв Ё¬п д (c)« }
      Assign(DataFile,s); {Ћвбо¤  ­ зЁ­ овбп ­(r)ўлҐ бва(r)ЄЁ}
      {$I-}
      Reset(DataFile);
      if IOResult <> 0 then
        Rewrite(DataFile);
      OpFileF := IOResult=0;
      {$I+}
      if OpFileF then
        begin
          DisableCommands(WinCom2);
          EnableCommands(WinCom1);
          Work                    {ЏҐаҐе(r)¤Ё¬ Є а Ў(r)вҐ}
        end
      end;
  end; {case Control}
  Dispose(PF, Done) 		{“­Ёзв(r)¦ Ґ¬ нЄ§Ґ¬Ї«па}
end; {FileOpen}
{------------------}
Procedure TNotebook.FileSave;
{‡ Єалў Ґв д (c)« ¤ ­­ле}
begin
  Close(DataFile);
  OpFileF := False;
  EnableCommands(WinCom2); {ђ §аҐи Ґ¬ (r)вЄалвм д (c)«}
  DisableCommands(WinCom1) {‡ ЇаҐй Ґ¬ а Ў(r)вг Ё б(r)еа ­Ґ­ЁҐ}
end; {TNotebook.FileSave}
{------------------}
Procedure TNotebook.ChangeDir;
{?§¬Ґ­пҐв ⥪гйЁ(c) Є в «(r)Ј}
var
  PD: PChDirDialog; {„Ё «(r)Ј(r)ў(r)Ґ (r)Є­(r) ᬥ­л Є в «(r)Ј /¤ЁбЄ }
  Control: Word;
begin
  New(PD, Init(cdNormal,0)); 		{‘(r)§¤ Ґ¬ ¤Ё «(r)Ј(r)ў(r)Ґ (r)Є­(r)}
  Control := DeskTop^.ExecView(PD);	{?бЇ(r)«м§гҐ¬ (r)Є­(r)}
  ChDir(PD^.DirInput^.Data^); 	{“бв ­(r)ў«Ёў Ґ¬
						­(r)ўл(c) Є в «(r)Ј}
  Dispose(PD, Done) 			{“¤ «пҐ¬ (r)Є­(r) Ё§ ЄгзЁ}
end; {TNotebook.ChangeDir}
{--------------------}
Procedure TNotebook.DOSCall;
{‚६Ґ­­л(c) ўле(r)¤ ў „Ћ‘}
const
  txt ='„«п ў(r)§ўа в  ўўҐ¤ЁвҐ EXIT ў (r)⢥в'+
       ' ­  ЇаЁЈ« 襭ЁҐ „Ћ‘...';
begin
  DoneEvents; 		{‡ Єалвм (r)Ўа Ў(r)взЁЄ б(r)ЎлвЁ(c)}
  DoneVideo; 		{‡ Єалвм ¬(r)­Ёв(r)а нЄа ­ }
  DoneMemory; 		{‡ Єалвм ¬(r)­Ёв(r)а Ї ¬пвЁ}
  SetMemTop(HeapPtr); 	{Ћбў(r)Ў(r)¤Ёвм Єгзг}
  WriteLn(txt); 		{‘(r)(r)ЎйЁвм (r) ўле(r)¤Ґ}
  SwapVectors; 		{“бв ­(r)ўЁвм бв ­¤ ав­лҐ ўҐЄв(r)ал}
  {ЏҐаҐ¤ вм гЇа ў«Ґ­ЁҐ Є(r)¬ ­¤­(r)¬г Їа(r)жҐбб(r)аг „Ћ‘:} 
  Exec(GetEnv('COMSPEC'),'');
  {‚Ґа­гвмбп Ё§ „Ћ‘:}
  SwapVectors; 		{‚(r)ббв ­(r)ўЁвм ўҐЄв(r)ал}
  SetMemTop(HeapEnd); 	{‚(r)ббв ­(r)ўЁвм Єгзг}
  InitMemory; 		{ЋвЄалвм ¬(r)­Ёв(r)а Ї ¬пвЁ}
  InitVideo; 		{ЋвЄалвм ¬(r)­Ёв(r)а нЄа ­ }
  InitEvents; 		{ЋвЄалвм (r)Ўа Ў(r)взЁЄ б(r)ЎлвЁ(c)}
  InitSysError; 		{ЋвЄалвм (r)Ўа Ў(r)взЁЄ (r)иЁЎ(r)Є}
  Redraw           	{‚(r)ббв ­(r)ўЁвм ўЁ¤ нЄа ­ }
end; {DOSCall}
{------------------}
Constructor TInterior.Init;
{‘(r)§¤ Ґв (r)Є­(r) бЄаа(r)««Ґа }
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;
{—Ёв Ґв б(r)¤Ґа¦Ё¬(r)Ґ д (c)«  ¤ ­­ле ў ¬ ббЁў 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;
{‚лў(r)¤Ёв ¤ ­­лҐ ў (r)Є­(r) Їа(r)б¬(r)ва }
var
  n, 			{’ҐЄгй п бва(r)Є  нЄа ­ }
  k: Integer; 	        {’ҐЄгй п бва(r)Є  ¬ ббЁў }
  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 - Є(r)«ЁзҐбвў(r) бва(r)Є (r)Є­ }
    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;
{Џ(r)«гз Ґв Є(r)¬ ­¤г Ё§ (r)б­(r)ў­(r)Ј(r) ¤Ё «(r)Ј(r)ў(r)Ј(r) (r)Є­ }
const
  X = 1;
  L = 12;
  DX= 13;
  But: array [0..4] of String [13] = {Ќ ¤ЇЁбЁ ­  Є­(r)ЇЄ е:} 
  ('~1~ ‚ле(r)¤ ','~2~ “Ўа вм ','~3~ ?бЄ вм ',
  '~4~ ?§¬Ґ­Ёвм ','~5~ „(r)Ў ўЁвм ');
  Txt: array [0..3] of String [52] = (
  {‘Їа ў(r)з­л(c) ⥪бв:}
  '“Ўа вм - г¤ «Ёвм § ЇЁбм, ўл¤Ґ«Ґ­­го 梥в(r)¬',
  '?бЄ вм - ЁбЄ вм § ЇЁбм, ­ зЁ­ ойгобп ­г¦­л¬Ё ЎгЄў ¬Ё',
  '?§¬Ґ­Ёвм - Ё§¬Ґ­Ёвм Ї(r)«Ґ (Ї(r)«п) ўл¤Ґ«Ґ­­(r)(c) § ЇЁбЁ',
  '„(r)Ў ўЁвм - ¤(r)Ў ўЁвм ­(r)ўго § ЇЁбм');
var
  R: TRect;
  D: PDlgWin;
  k: Integer;
begin
  R.Assign(7,6,74,15);
  D := New(PDlgWin,Init(R, '‚лЎҐаЁвҐ Їа(r)¤(r)«¦Ґ­ЁҐ:'));
  with D^ do
    begin
      for k := 0 to 3 do {‚бв ў«пҐ¬ Ї(r)пб­пойЁ(c) ⥪бв}
        begin
          R.Assign(1,1+k,65,2+k);
          Insert(New(PStaticText,Init(R,#3+Txt[k])))
        end;
      for k := 0 to 4 do {‚бв ў«пҐ¬ Є­(r)ЇЄЁ:}
        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); {ЂЄвЁўЁ§Ёа㥬 ЇҐаўго Є­(r)ЇЄг}
    end;
  Control := DeskTop^.ExecView(D); {‚лЇ(r)«­пҐ¬ ¤Ё «(r)Ј}
end; {Control}
{-----------------}
Procedure TInterior.HandleEvent;
Procedure DeleteItem;
{“¤ «пҐв гЄ § ­­л(c) ў Location н«Ґ¬Ґ­в ¤ ­­ле}
var
  D: Integer;
  PStr: PString;
  s: String;
  Data: DataType;
begin
  PStr := PS^.At(Location); 	{Џ(r)«гз Ґ¬ ⥪гйго § ЇЁбм}
  s := copy(PStr^,1,LName);
  seek(DataFile,0);
  D := -1; 				{D - ­(r)¬Ґа § ЇЁбЁ ў д (c)«Ґ}
  repeat         	{–ЁЄ« Ї(r)ЁбЄ  Ї(r) б(r)ўЇ ¤Ґ­Ёо Ї(r)«п 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); 	{—Ёв Ґ¬ Ї(r)б«Ґ¤­оо § ЇЁбм}
  seek(DataFile,D);
  write(DataFile,Data); {Џ(r)¬Ґй Ґ¬ ҐҐ ­  ¬Ґбв(r) г¤ «пҐ¬(r)(c)}
  seek(DataFile,pred(FileSize(DataFile)));
  truncate(DataFile); 	{“¤ «пҐ¬ Ї(r)б«Ґ¤­оо § ЇЁбм}
  with PS^ do D := IndexOf(At(Location));
  PS^.AtFree(D); 		{“¤ «пҐ¬ бва(r)Єг Ё§ Є(r)««ҐЄжЁЁ}
  Draw                  {ЋЎ­(r)ў«пҐ¬ (r)Є­(r)}
end; {DeleteItem}
{------------------}
Procedure AddItem(Edit: Boolean);
{„(r)Ў ў«пҐв ­(r)ўл(c) Ё«Ё । ЄвЁагҐв бв ал(c) н«Ґ¬Ґ­в ¤ ­­ле}
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)); 	{„(r)Ў ў«пҐ¬ § ЇЁбЁў Є(r)­Ґж д (c)« }
  repeat {–ЁЄ« ўў(r)¤  § ЇЁбҐ(c)}
    if Edit then {ѓ(r)в(r)ўЁ¬ § Ј(r)«(r)ў(r)Є}
      s := 'ђҐ¤ ЄвЁа(r)ў ­ЁҐ:'
    else
      begin
        Str(FileSize(DataFile)+1,s);
        while Length(s) < 3 do
          s := '0'+s;
        s := '‚ў(r)¤Ёвбп § ЇЁбм N '+s
      end;
    FillChar(Data,SizeOf(Data),' '); 	{‡ Ї(r)«­пҐ¬ Ї(r)«п	Їа(r)ЎҐ« ¬Ё}
    R.Assign(15,5,65,16);
    InWin := New(PDialog, Init(R, s)); 	{‘(r)§¤ Ґ¬ (r)Є­(r)}
    with InWin^ do
      begin  					{”(r)а¬Ёа㥬 (r)Є­(r):} 
        R.Assign(2,y+1,2+LName,y+2);
        BName := New(PInputLine, Init(R,LName));
        Insert(BName); 				{Џ(r)«Ґ Ё¬Ґ­Ё}
        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)«Ґ ⥫Ґд(r)­ }
        R.Assign(2,y+dy,2+LPhone,y+dy+1);
        Insert(New(PLabel,
        			Init(R, '’Ґ«Ґд(r)­',BPhone)));
        R.Assign(2,y+2*dy+1,2+LAddr,y+2*dy+2);
        BAddr := New(PInputLine, Init(R,LAddr));
        Insert(BAddr); 				{Џ(r)«Ґ  ¤аҐб }
        R.Assign(2,y+2*dy,2+LAddr,y+2*dy+1);
        Insert(New(PLabel,
        Init(R, 'Ђ¤аҐб',BAddr)));
        {‚бв ў«пҐ¬ ¤ўҐ Є(r)¬ ­¤­лҐ Є­(r)ЇЄЁ:}
        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, '‚ле(r)¤',cmCancel,bfNormal)));
        SelectNext(False) 	{ЂЄвЁўЁ§Ёа㥬 ЇҐаўго Є­(r)ЇЄг}
      end; {Љ(r)­Ґж д(r)а¬Ёа(r)ў ­Ёп (r)Є­ }
    if Edit then with Data do
      begin {ѓ(r)в(r)ўЁ¬ ­ з «м­л(c) ⥪бв:}
        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) {‚бв ў«пҐ¬ ⥪бв ў Ї(r)«п ўў(r)¤ }
      end;
    Control := DeskTop^.ExecView(InWin); {‚лЇ(r)«­пҐ¬ ¤Ё «(r)Ј}
    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; {ЏаҐ¦­ҐҐ Є(r)«ЁзҐбвў(r) § ЇЁбҐ(c)}
        PS^.Insert(NewStr(s)); {„(r)Ў ў«пҐ¬	ў Є(r)««ҐЄжЁо}
        {Џа(r)ўҐа塞 ¤(r)Ў ў«Ґ­ЁҐ}
        if OldCount <> PS^.Count then
          Write(DataFile,Data) {„  - ¤(r)Ў ў«пҐ¬ ў д (c)«}
      end
  until Edit or (Control=cmCancel);
  Draw
end; {AddItem}
{------------------}
Procedure SearchItem;
{?йҐв ­г¦­л(c) н«Ґ¬Ґ­в}
Function UpString(s: String): String;
{ЏаҐ(r)Ўа §гҐв бва(r)Єг ў ўҐае­Ё(c) ॣЁбва}
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,'Џ(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)Ўа §Ґж ¤«п Ї(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,'‚ле(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 	{Џ(r)«гзЁвм Є(r)¬ ­¤г Ё§
				(r)б­(r)ў­(r)Ј(r) ¤Ё «(r)Ј(r)ў(r)Ј(r) (r)Є­ }
    cmCan,
    cmCancel: EndModal(cmCancel);
    cmEdit  : AddItem(True);
    cmDelete: DeleteItem;
    cmSearch: SearchItem;
    cmAdd   : AddItem(False);
    end
    end;
    cmZoom: exit;
    end;
  evMouseDown: 				{ђҐ ЄжЁп ­  饫з(r)Є ¬лимо}
    begin
      MakeLocal(MouseWhere, R); 	{Џ(r)«гз Ґ¬ ў R «(r)Є «м­лҐ
    						Є(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;
{ђ Ў(r)в  б ¤ ­­л¬Ё}
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);
{ЋЎа Ў(r)взЁЄ б(r)ЎлвЁ(c) Їа(r)Ја ¬¬л}
begin	{TNotebook.HandleEvent}
  TApplication.HandleEvent(Event); {ЋЎа Ў(r)вЄ  бв ­¤ ав­ле 
						Є(r)¬ ­¤ cmQuit Ё cmMenu}
  if Event.What = evCommand then
  case Event.Command of
    {ЋЎа Ў(r)вЄ  ­(r)ўле Є(r)¬ ­¤:} 
    cmOpen: FileOpen; 	{ЋвЄалвм д (c)«}
    cmSave: FileSave; 	{‡ Єалвм д (c)«}
    cmChangeDir : ChangeDir; 	{‘¬Ґ­Ёвм ¤ЁбЄ}
    cmDOSShell : DOSCall; 		{‚६Ґ­­л(c) ўле(r)¤ ў „Ћ‘}
    cmWork : Work; 		{ЋЎа Ў(r)в вм ¤ ­­лҐ}
  else
    exit      			{ЌҐ (r)Ўа Ў влў вм ¤агЈЁҐ Є(r)¬ ­¤л}
  end;
  ClearEvent(Event) 	{ЋзЁбвЁвм б(r)ЎлвЁҐ Ї(r)б«Ґ (r)Ўа Ў(r)вЄЁ}
end; {TNotebook.HandleEvent}
{----------------------}
Procedure TNotebook.InitMenuBar;
{‘(r)§¤ ­ЁҐ ўҐае­ҐЈ(r) ¬Ґ­о}
var
  R: TRect;
begin
  GetExtent(r);
  R.B.Y := succ(R.A.Y); {R - Є(r)(r)а¤Ё­ вл бва(r)ЄЁ ¬Ґ­о}
  MenuBar := New(PMenuBar, Init(R,
    NewMenu(		{‘(r)§¤ Ґ¬ ¬Ґ­о}
    	{ЏҐаўл(c) н«Ґ¬Ґ­в ­(r)ў(r)Ј(r) ¬Ґ­о ЇаҐ¤бв ў«пҐв б(r)Ў(r)(c)
	Ї(r)¤¬Ґ­о (¬Ґ­о ўв(r)а(r)Ј(r) га(r)ў­п). ‘(r)§¤ Ґ¬ ҐЈ(r)}
  	NewSubMenu('~F~/” (c)«', hcNoContext,
  	{ЋЇЁблў Ґ¬ н«Ґ¬Ґ­в Ј« ў­(r)Ј(r) ¬Ґ­о}
  	  NewMenu(		{‘(r)§¤ Ґ¬ Ї(r)¤¬Ґ­о}
  		NewItem(	{ЏҐаўл(c) н«Ґ¬Ґ­в}
  		'~1~/ ЋвЄалвм','F3',kbF3,cmOpen,hcNoContext,
  		NewItem(	{‚в(r)а(r)(c) н«Ґ¬Ґ­в}
  		'~2~/ ‡ Єалвм','F2',kbF2,cmSave,hcNoContext,
  		NewItem(	{’аҐвЁ(c) н«Ґ¬Ґ­в}
  		'~3~/ ‘¬Ґ­Ёвм ¤ЁбЄ','',0,cmChangeDir,hcNoContext,
  		NewLine(	{‘ва(r)Є -а §¤Ґ«ЁвҐ«м}
  		NewItem('~4~/ ‚л§(r)ў „Ћ‘','',0,cmDOSShell,hcNoContext,
  		NewItem('~5~/ Љ(r)­Ґж а Ў(r)вл','Alt-X',
  					kbAltX,cmQuit,hcNoContext,
  	NIL)))))) 		{ЌҐв ¤агЈЁе н«Ґ¬Ґ­в(r)ў Ї(r)¤¬Ґ­о}
      ),
      {‘(r)§¤ Ґ¬ ўв(r)а(r)(c) н«Ґ¬Ґ­в Ј« ў­(r)Ј(r) ¬Ґ­о}
      NewItem('~W~/ ђ Ў(r)в ','',kbF4,cmWork,hcNoContext,
  NIL) {ЌҐв ¤агЈЁе н«Ґ¬Ґ­в(r)ў Ј« ў­(r)Ј(r) ¬Ґ­о}
  ))))
end; {TNotebook.InitMenuBar}
{------------------}
Procedure TNotebook.InitStatusLine;
{”(r)а¬ЁагҐв бва(r)Єг бв вгб }
var
  R: TRect; {ѓа ­Ёжл бва(r)ЄЁ бв вгб }
begin
  GetExtent(r); {Џ(r)«гз Ґ¬ ў R Є(r)(r)а¤Ё­ вл ўбҐЈ(r) нЄа ­ }
  R.A.Y := pred(R.B.Y);
  StatusLine := New(PStatusLine,
  Init(R, 				{‘(r)§¤ Ґ¬ бва(r)Єг бв вгб }
    NewStatusDef(0, $FFFF, 	{“бв ­ ў«Ёў Ґ¬  ¬ ЄбЁ¬ «м­л(c) 				¤Ё Ї §(r)­ Є(r)­вҐЄбв­(r)(c) бЇа ў(r)з­(r)(c) б«г¦Ўл}
    NewStatusKey('~Alt-X~ ‚ле(r)¤', kbAltX, cmQuit,
    NewStatusKey('~F2~ ‡ Єалвм', kbF2, cmSave,
    NewStatusKey('~F3~ ЋвЄалвм', kbF3, cmOpen,
    NewStatusKey('~F4~ ђ Ў(r)в ', kbF4, cmWork,
    NewStatusKey('~F10~ ЊҐ­о', kbF10, cmMenu,
    NIL))))), 	{ЌҐв ¤агЈЁе Є« ўЁи}
  NIL) 		{ЌҐв ¤агЈЁе (r)ЇаҐ¤Ґ«Ґ­Ё(c)}
  ));
  DisableCommands(WinCom1) {‡ ЇаҐй Ґ¬ ­Ґ¤(r)бвгЇ­лҐ Є(r)¬ ­¤л}
end; {TNotebook.InitStatusLine}
{-------------------}
var
  Nbook: TNotebook;
begin
  Nbook.Init;
  Nbook.Run;
  Nbook.Done
end.
dron4ik
Помогите кто нибудь(((
volvo
Чем тебе помочь? Сказать, ООП ли это? Да, вот это - настоящее Объектно-Ориентированное Программирование. Построенное на использовании библиотеки TurboVision...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.