IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> ООП на Turbo Pascal, Переход от процедурного программирования к модульному.
сообщение
Сообщение #1


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


Всем привет. Возникла такая проблема...Дана задача написать телефонный справочник на Турбо Паскале принципом Объектного Ориентированного Программирования.(модульное программирование). у меня есть листинг программы...но проблема в том что программа написанна вроде не принципом Объектного Ориентированного Программирования а процедурным... я незнаю как перевести этот код в Объектно Ориентированное программирование(модульное программирование) т.е. к проге наверно должны быть привязаны модули.

Программа умеет добавлять, изменять, удалять, искать записи. Также, для упрощения работы с программой, создан интуитивно понятный интерфейс.В программе используется следующий алгоритм работы с данными: все данные хранятся в файле 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.


Сообщение отредактировано: dron4ik -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 7)
сообщение
Сообщение #2


Гость






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

P.S. Перенесено в раздел "Задачи".
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


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

Добавлено через 10 мин.
Т.е. выделение групп подпрограмм использующих одни и те же глобальные данные в отдельно компилируемые модули.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


А как мне разбить на модули, которые реализованы ввиде объектов?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

Репутация: -  16  +


http://pascal-books.narod.ru/books/examples.zip
Рекомендую посмотреть пример телефонной книги от Фаронова
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


Спасибо). А он подходит к ООП?

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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


Помогите кто нибудь(((
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Чем тебе помочь? Сказать, ООП ли это? Да, вот это - настоящее Объектно-Ориентированное Программирование. Построенное на использовании библиотеки TurboVision...
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.03.2024 16:57
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name