Реферат: Обучение начальных курсов методам программирования на языке Turbo Pascal



Для передвижения по тексту используются клавиши управления курсором и клавиши PgUp и PgDown.

Необходимую информацию о программе можно получить воспользовавшись пунктом меню "О программе".

Выход из программы производится выбором пункта меню "Выход".

Для просмотра теории по теме "Строковый тип данных" производится выбором пункта меню "Теория".

1 Краткая теория

Строковые типы

Значением строкового типа является последовательность симво­лов с динамическим атрибутом длины (в зависимости от действитель­ного числа символов при выполнении программы) и постоянным атри­бутом размера в диапазоне от 1 до 255. Текущее значение атрибута длины можно получить с помощью стандартной функции Length.

--------

строковый тип --->|string---------------------------------->

-------- | ^

| ----- ------- ----- |

-->| [ --->|целое--->| ] ---

----- | без | -----

|знака|

-------

Отношение между любыми двумя строковыми значениями устанав­ливается согласно отношению порядка между значениями символов в соответствующих позициях. В двух строках разной длины каждый сим­вол более длинной строки без соответствующего символа в более ко­роткой строке принимает значение "больше"; например, 'Xs' больше, чем 'X'. Нулевые строки могут быть равны только другим нулевым строкам, и они являются наименьшими строковыми значениями.

К идентификатору строкового типа и к ссылке на переменную строкового типа можно применять стандартные функции Low и High. В этом случае функция Low возвращает 0, а High возвращает атрибут размера (максимальную длину) данной строки.

Параметр-переменная, описанная с помощью идентификатора OpenString и ключевого слова string в состоянии $P+, является открытым строковым параметром. Открытые строковые параметры поз­воляют передавать одной и той же процедуре или функции строковые переменные изменяющегося размера.

Конкретный элемент массива обозначается с помощью ссылки на переменную массива, за которой указывается индекс, определяющий

данный элемент.

Конкретный символ в строковой переменной обозначается с по­мощью ссылки на строковую переменную, за которой указывается ин­декс, определяющий позицию символа.

----- ----------- -----

индекс -->| [ -------->|выражение-------->| ] --->

----- ^ ----------- | -----

| ----- |

--------- , |<--------

-----

Индексные выражения обозначают компоненты в соответствующей размерности массива. Число выражений не должно превышать числа индексных типов в описании массива. Более того, тип каждого выра­жения должен быть совместимым по присваиванию с соответствующим индексным типом.

В случае многомерного массива можно использовать несколько индексов или несколько выражений в индексе. Например:

Matrix[I][J]

что тождественно записи:

Matrix[I,J]

Строковую переменную можно проиндексировать с помощью оди­ночного индексного выражения, значение которого должно быть в ди­апазоне 0...n, где n - указанный в описании размер строки. Это дает доступ к каждому символу в строковом значении, если значение символа имеет тип Char.

Первый символ строковой переменной (индекс 0) содержит дина­мическую длину строки, то есть Length(S) тождественно Ord(S[0]). Если атрибуту длины присваивается значение, то компилятор не про­веряет, является ли это значение меньшим описанного размера стро-

ки. Вы можете указать индекс строки и вне ее текущей динамической

длины. В этом случае считываемые символы будут случайными, а

присваивания вне текущей длины не повлияют на действительное зна­чение строковой переменной.

Когда с помощью директивы компилятора $X+ разрешен расши­ренный синтаксис, значение PChar может индексироваться одиночным индексным выражением типа Word. Индексное выражение задает смеще­ние, которое нужно добавить к символу перед его разыменованием для получения ссылки на переменную типа Char.

Открытые параметры позволяют передавать одной и той же про­цедуре или функции строки и массивы различных размеров.

Открытые строковые параметры могут описываться двумя спосо­бами:

- с помощью идентификатора OpenString;

- с помощью ключевого слова string в состоянии $P+.

Идентификатор OpenString описывается в модуле System. Он обозначает специальный строковый тип, который может использовать­ся только в описании строковых параметров. В целях обратной сов­местимости OpenString не является зарезервированным словом и мо­жет, таким образом, быть переопределен как идентификатор, задан­ный пользователем.

Когда обратная совместимость значения не имеет, для измене­ния смысла ключевого слова string можно использовать директиву компилятора $P+. В состоянии $P+ переменная, описанная с клю­чевым словом string, является открытым строковым параметром.

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

Открытые строковые параметры ведут себя также как парамет-

ры-переменные строкового типа, только их нельзя передавать как

обычные переменные другим процедурам или функциям. Однако, их

можно снова передать как открытые строковые параметры.

В следующем примере параметр S процедуры AssignStr - это открытый строковый параметр:

procedure AssignStr(var S: OpenString);

begin

S := '0123456789ABCDEF'; end;

Так как S - это открытый строковый параметр, AssignStr можно передавать переменные любого строкового типа:

var

S1: string[10];

S1: string[20]; begin

AssignStr(S1); S1 := '0123456789'

AssignStr(S2); S2 := '0123456789ABCDEF'

end;

В AssingStr максимальная длина параметра S та же самая, что у фактического параметра. Таким образом, в первом вызове AssingStr при присваивании параметра S строка усекается, так как максимальная длина S1 равна 10.

При применении к открытому строковому параметру стандартная функция Low возвращает 0, стандартная функция High возвращает описанную максимальную длину фактического параметра, а функция SizeOf возвращает размер фактического параметра.

В следующем примере процедура FillString заполняет строку заданным символом до ее максимальной длины. Обратите внимание на использование функции High для получения максимальной длины отк­рытого строкового параметра.

procedure FillStr(var S: OpenString; Ch: Char);

begin

S[0] := Chr(High(S)); задает длину строки

FillChar(S[1], High(S), Ch); устанавливает число символов

end;

Значения и параметры-константы, описанные с использованием идентификатора OpenString или ключевого слова string в состоянии $P+, не являются открытыми строковыми параметрами. Они ведут себя также, как если бы были описаны с максимальной длиной стро­кового типа 255, а функция Hingh для таких параметров всегда возвращает 255.

uses crt,dos;

var i,j,i1,x:integer;

DI: SearchRec;

textf:array[1..800] of string[79];

procedure music;

begin

sound(800);

delay(200);

nosound;

end;

procedure myerror (s:string);

var c:char;

begin

textbackground(4);

window(10,10,70,16);

clrscr;

textcolor(15);

write('????????????????????????? Внимание ??????????????????????????');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('?????????????????????????????????????????????????????????????');

gotoxy(10,2);

write(' В текущем каталоге нет файла ',s,'.');

gotoxy(15,3);

write(' Без него не могу работать.');

textbackground(1);

gotoxy(27,5);

write(' Да ');

c:=chr(1);

{ выдаёт звукавой сигнал }

music;

while(c<>chr(13)) do

c:=readkey;

end;

procedure ins(x,y,w:integer;ct,ft:integer);

var l,i:integer;

attr:byte;

begin

attr:=ct+16*ft;

if lastmode=co40 then l:=y*80+2*x+1;

if lastmode=co80 then l:=y*160+2*x+1;

i:=l;

while (i

begin

mem[$b800:i]:=attr;

i:=i+2;

end;

end;

procedure hide;

var r:registers;

begin

r.ah:=$01;

r.ch:=$20;

r.cl:=$00;

intr($10,r);

end;

function myexit:boolean;

var c:char;

i,x:integer;

begin

window(20,8,55,13);

textbackground(7);

textcolor(0);

write('????????Прекратить просмотр?????????');

write('? ?');

write('? ?');

write('? ?');

write('????????????????????????????????????');

textbackground(6);

gotoxy(8,3);

write(' да ' );

textbackground(3);

gotoxy(21,3);

write(' нет ');

ins(20,12,36,7,0);

ins(55,12,1,7,0);

ins(55,11,1,7,0);

ins(55,10,1,7,0);

ins(55,9,1,7,0);

ins(55,8,1,7,0);

c:=chr(1);

i:=1;

x:=26;

while(c<>chr(13)) do

begin

c:=readkey;

{ по ESC закрывает запрос }

if c=chr(27) then begin i:=2;break;end;

if c=chr(0) then begin

c:=readkey;

ins(x,9,7,15,3);

if c=chr(77) then if i=2 then begin x:=26;i:=1;end

else begin x:=39;i:=2;end;

if c=chr(75) then if i=2 then begin x:=26;i:=1;end

else begin x:=39;i:=2;end;

ins(x,9,7,15,6);

end;

end;

case i of

1:myexit:=true;

2:myexit:=false;

end;

end;

procedure obuch;

var n,c:char;

s,zx:string;

t:boolean;

y,x,y1,m:integer;

f:text;

begin

window(1,1,80,25);

textbackground(0);

clrscr;

hide;

m:=1;i:=1;

window(1,1,80,2);

textbackground(2);

clrscr;

textcolor(5);

write('строка 21');

gotoxy(20,1);

window(1,23,80,24);

textbackground(2);

clrscr;

window(1,2,80,23);

textbackground(1);

clrscr;

textbackground(7);

window(1,1,80,25);

gotoxy(20,1);

gotoxy(2,24);

write(' ',char(24),' - вверх ');

gotoxy(14,24);

write(' ',char(25),' - вниз ');

gotoxy(25,24);

write(' PgUp - лист вверх ');

gotoxy(45,24);

write(' PgDn - лист вниз ');

gotoxy(65,24);

write(' ESC - выход ');

textbackground(1);

textcolor(15);

window(1,2,80,23);

assign(f,'curswork.txt');

reset(f);

while((i=1)and(m<796)) do

begin

readln(f,s);

if (s[1]='#')and(s[2]='#')and(s[3]='#') then break;

textf[m]:=s;

if m<22>

m:=m+1;

end;

x:=m;

c:=chr(1);

m:=0;

while c<>chr(27) do

begin

c:=readkey;

if c=chr(27) then if myexit then c:=chr(27) else begin

c:=chr(1);

window(1,2,80,23);

textbackground(1);

clrscr;

textcolor(15);

for i:=m to m+21 do

begin

writeln(textf[i]);

end;

end;

if c=chr(0) then begin

c:=readkey;

if ((c=chr(81))) then if (m+23<=x-23) then m:=m+21 else m:=x-21;

if ((c=chr(73))) then if (m-23>1) then m:=m-21 else m:=0;

if ((c=chr(80)) and (x-23>=m)) then m:=m+1;

if ((c=chr(72)) and (m>0))then m:=m-1;

clrscr;

for i:=m to m+21 do

begin

writeln(textf[i]);

end;

window(1,1,80,25);

gotoxy(1,1);

textbackground(2);

textcolor(5);

write(' ');

gotoxy(1,1);

write('строка ',m+1);

window(1,2,80,23);

textcolor(15);

textbackground(1);

end;

end;

textbackground(0);

window(1,1,80,25);

clrscr;

end;

function select:integer;

var om:integer;

c:char;

begin

om:=lastmode;

textmode(co40);

textbackground(0);

hide;

window(5,3,35,20);

textbackground(1);

clrscr;

textcolor(15);

window(1,1,40,25);

gotoxy(1,3);

for i:=5 to 35 do

begin

gotoxy(i,5);

write('?');

gotoxy(i,20);

write('?');

end;

for i:=5 to 20 do

begin

gotoxy(5,i);

write('?');

gotoxy(35,i);

write('?');

end;

gotoxy(5,20);

write('?');

gotoxy(5,5);

write('?');

gotoxy(35,20);

write('?');

gotoxy(35,5);

write('?');

textcolor(5);

gotoxy(5,3);

write(' Строковый тип данных в TP 7.0 ');

textcolor(15);

gotoxy(12,8);

write('Теория');

gotoxy(12,10);

write('Помощь');

gotoxy(12,12);

write('О программе');

gotoxy(12,14);

write('Выход');

ins(5,x,29,1,2);

c:=chr(1);

while(c<>chr(13)) do

begin

c:=readkey;

if c=chr(0) then begin

c:=readkey;

ins(5,x,29,15,1);

if c=chr(80) then

if i1=4 then begin x:=7;i1:=1;end

else begin x:=x+2;i1:=i1+1; end;

if c=chr(72) then

if i1=1 then begin x:=13;i1:=4;end

else begin x:=x-2;i1:=i1-1; end;

ins(5,x,29,1,2);

end;

end;

textmode(om);

case (i1) of

1:select:=1;

2:select:=2;

3:select:=3;

4:select:=4;

end;

end;

procedure help;

var s:string;

f:text;

i:byte;

begin

textmode(co80);

hide;

window(10,5,70,20);

textbackground(1);

textcolor(15);

clrscr;

write('???????????????????????? Справка ????????????????????????????');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? Выход любая клавиша ?');

write('?????????????????????????????????????????????????????????????');

assign(f,'help.txt');

reset(f); i:=2;

while not(eof(f)) do

begin

gotoxy(2,i);

readln(f,s);

if ((s[1]='#') and (s[2]='#')) then break;

writeln(s);

i:=i+1;

end;

close(f);

readkey;

end;

procedure about;

var f:text;

q:byte;

s:string;

begin

textmode(co80);

hide;

window(10,5,70,20);

textbackground(1);

textcolor(15);

clrscr;

write('?????????????????????? О программе ?????????????????????????');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? ?');

write('? Выход любая клавиша ?');

write('?????????????????????????????????????????????????????????????');

assign(f,'about.txt');

reset(f);

q:=2;

while not(eof(f)) do

begin

gotoxy(2,q);

readln(f,s);

if ((s[1]='#') and (s[2]='#')) then break;

writeln(' ',s);

q:=q+1;

end;

close(f);

readkey;

end;

begin

hide;

findfirst('curswork.txt',anyfile,di);

if doserror<>0 then begin

myerror('curswork.txt');

halt(1);

end;

findfirst('help.txt',anyfile,di);

if doserror<>0 then begin

myerror('help.txt');

halt(1);

end;

findfirst('about.txt',anyfile,di);

if doserror<>0 then begin

myerror('about.txt');

halt(1);

end;

j:=1;

i1:=1;

x:=7;

while j=1 do

begin

i:=select;

case i of

1:obuch;

2:help;

3:about;

4:begin textbackground(0);clrscr;halt;end;

end;

end;

end.

{----------------------------------main--------------------------------------}

Program BookPhone;

uses

crt;

type

MnChoice = Char;

num=string[10];

StFio = string[30];

Adress=string[50];

RecBook = record

Fio : StFio;

Adress: Adress;

num:num;

end;

var

BookFile : file of RecBook;

Work : RecBook;

Vid : MnChoice;

End_Menu : boolean;

Name : string[30];

{--------------------------------procedures----------------------------------}

{Ја дЁЄ }

Procedure Box;

var x,y : integer;

begin

TextColor(1);

x :=5;y :=3;

GotoXY(x,y);

write(#177);

for x := 6 to 76 do

begin

GotoXY(x,y);

Write(#177);

end;

for y := 4 to 21 do

begin

GotoXY(x,y);

Write(#177);

end;

for x := 75 downto 5 do

begin

GotoXY(x,y);

Write(#177);

end;

for y :=20 downto 4 do

begin

GotoXY(x,y);

Write(#177);

end;

end;

Procedure Work_Window;

var I,J : Integer;

begin

TextBackGround(195);

ClrScr;

Box;

Window(6,4,75,20);

TextBackGround(LightGray);

ClrScr;

TextColor(Black);

end;

{****************************************************************************}

{бЁб⥬­лҐ Їа®жҐ¤гал}

Procedure Name_File;

begin

Work_Window;

Write(' ‚ўҐ¤ЁвҐ Ё¬п д ©«  б ¤ ­­л¬Ё >');

TextColor(3);

Readln(Name);

TextColor(Black);

ClrScr;

end;

{****************************************************************************}

Procedure Curr_File;

begin

GotoXY(1,1);

Write(' ’ҐЄгйЁ© ” ©«:');

TextColor(3);Writeln(Name);TextColor(Black);

end;

{****************************************************************************}

Procedure AddRec;

begin

Work_Window;

Write(' ­®¬Ґа ¤®Ў ў«пҐ¬®© § ЇЁбЁ ');

TextColor(4);Write(FilePos(BookFile)+1);

TextColor(Black);

with Work do

begin

writeln;

TextColor(Black);

Write(' ”€Ћ ');

Textcolor(LIghtRed);

Readln(fio);

TextColor(Black);

Write(' Ќ®¬Ґа ⥫Ґд®­  ');

TextColor(LightRed);

Readln(num);

TextColor(Black);

Write(' Ђ¤аҐб ');

Textcolor(LIghtRed);

Readln(adress);

TextColor(Black);

Write(BookFile,Work);

end;

end;

{****************************************************************************}

Procedure Create_Book_Phone;

var

Ind, Count : integer;

begin

Name_File;

Work_Window;

Assign(BookFile,Name);

Rewrite(BookFile);

Write(' ‘®§¤ о ­®ўл© д ©« ');

TextColor(LightRed);Writeln(Name);

TextColor(Black);

Write(' ‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® § ЇЁбҐ© ў д ©«Ґ ');

TextColor(LightRed);

Readln(Count);

TextColor(Black);

for Ind := 1 to Count do AddRec;

Writeln;

Writeln(' ‘®§¤ ­ЁҐ § ўҐа襭®');

Writeln;

Writeln(' Љ®«ЁзҐбвў® § ЇЁбҐ© ў д ©«Ґ ');

TextColor(LightRed);Writeln(Filesize(BookFile));

Close(BookFile);

end;

{****************************************************************************}

Procedure OutputRec;

begin

Read(BookFile,Work);

with Work do

begin

Writeln;

TextColor(Black);

Write(' Ќ®¬Ґа § ЇЁбЁ : ');

TextColor(4);Write(FilePos(BookFile));

TextColor(Black);

Writeln;

TextColor(Black);

writeln(' ');

Write(' ”€Ћ ');

Textcolor(4);

writeln(fio);

TextColor(Black);

Write(' Ќ®¬Ґа ⥫Ґд®­  ');

TextColor(4);

writeln(num);

TextColor(Black);

Write(' Ђ¤аҐб ');

Textcolor(4);

writeln(adress);

readkey;clrscr;

end;

end;

{****************************************************************************}

Procedure OutputAllRec;

begin

{ Name_File;}

Work_Window;

Assign(BookFile,Name);

{$I-}

Reset(BookFile);

{$I+}

if IOresult = 0 then

begin

Seek(BookFile, 0);(* setup on the 1-st record*)

{Writeln;

Write(' ‚лў®¤ Ё§ д ©«  ');

TextColor(4);

Writeln(Name);}

while (not Eof(BookFile)) do

OutputRec;

end

else {if IOresult <> 0 then}

begin

Write(' ” ©«: ');

TextColor(4);

Write(Name);

TextColor(Black);Writeln(' ­Ґ ­ ©¤Ґ­');

end;

end;

{****************************************************************************}

Procedure UpdateRec;

var

NumRec : LongInt;

begin

{ Name_File;}

Work_Window;

Assign(BookFile,Name);

{$I-}

Reset(BookFile);

{$I+}

if IOresult = 0 then

begin

Write(' Ќ®¬Ґа § ЇЁбЁ ¤«п । ЄвЁа®ў ­Ёп? ');

TextColor(4);

Readln(NumRec);

TextColor(Black);

Seek(BookFile,NumRec-1);

Writeln('--‘в а п § ЇЁбм--');

Writeln;

OutputRec;

Seek(BookFile,NumRec-1);

Readln;

Writeln('--‚ўҐ¤ЁвҐ ­®ўго § ЇЁбм--');

AddRec;

Close(BookFile);

end

else {if IOresult <> 0 then}

begin

Write(' ” ©«: ');

TextColor(4);

Write(Name);TextColor(Black);Writeln(' ­Ґ ­ ©¤Ґ­');

end;

end;

{****************************************************************************}

Procedure AddRecToEnd;

begin

{ Name_File;}

Work_Window;

Assign(BookFile,Name);

{$I-}

Reset(BookFile);

{$I+}

if IOresult = 0 then

begin

Seek(BookFile,FileSize(BookFile));

AddRec;

Writeln;

Write(' ‚ ¤ ­­®¬ д ©«Ґ ');

TextColor(4);Write(FileSize(Bookfile));

TextColor(Black);Writeln(' § ЇЁбҐ©');

Close(BookFile);

end

else{if IOresult <> 0 then}

begin

Write(' ” ©«: ');

TextColor(4);Write(Name);

TextColor(Black);Writeln(' ­Ґ ­ ©¤Ґ­');

end;

end;

{****************************************************************************}

Procedure FindFio;

var

BookFile : file of RecBook;

Work : RecBook;

Mask : StFio;

Rez_Find : boolean;

CountRec : integer;

begin

{Name_File;}

Work_Window;

Assign(BookFile, Name);

{$I-}

Reset(BookFile);

{$I+}

if IOresult = 0 then

begin

Write(' ‚ўҐ¤ЁвҐ ”.€.Ћ. ¤«п Ї®ЁбЄ  ');

TextColor(4);Readln(Mask);

TextColor(Black);

Writeln;

Rez_Find := False;

CountRec := 0;

while (not Eof(BookFile)) do

begin

Read(BookFile,Work);

with Work do

if Pos(Mask,Fio) <> 0 then

begin

Rez_Find:= True;

Inc(CountRec);

TextColor(Black);

Write(' ”€Ћ ');

Textcolor(4);

writeln(fio);

textcolor(black);

write('Ќ®¬Ґа ⥫Ґд®­  ');

TextColor(4);

writeln(num);

TextColor(Black);

Write(' Ђ¤аҐб ');

Textcolor(4);

writeln(adress);

{readkey;}

end;

end;

if Rez_Find then

Begin

Writeln;

Write(' Љ®«ЁзҐбвў® § ЇЁбҐ© ¤«п ');

TextColor(4);Write(Mask);Write(' ');Writeln(CountRec);

Textcolor(Black);

readkey;

End

else

Begin

Write(' ‡ ЇЁбм ¤«п ”.€.Ћ. ');

TextColor(4);Write(Mask);

TextColor(Black);Writeln(' ­Ґ ­ ©¤Ґ­  ');

readkey;

End;

Close(BookFile);

end

else{if IOresult <> 0 then}

Writeln(' ” ©« : ',Name,' ­Ґ ­ ©¤Ґ­ ');

readkey;

end;

{****************************************************************************}

Procedure Findnum;

var

BookFile : file of RecBook;

Work : RecBook;

PhMask : num;

Rez_Find : boolean;

CountRec : integer;

begin

{ Name_File;}

Work_Window;

Assign(BookFile, Name);

{$I-}

Reset(BookFile);

{$I+}

if IOresult = 0 then

begin

Write('‚ўҐ¤ЁвҐ ⥫Ґд®­ ');

TextColor(4);

Readln(PhMask);

TextColor(0);

Writeln;

Rez_Find := False;

CountRec := 0;

while (not Eof(BookFile)) do

begin

Read(BookFile,Work);

with Work do

if Pos(PhMask,num) <> 0 then

begin

Rez_Find:= True;

Inc(CountRec);

textcolor(0);

textcolor(0);

Write(' ”.€.Ћ. ');

TextColor(4);

Writeln(Fio);

TextColor(Black);

write(' Ќ®¬Ґа ⥫Ґд®­  ');

textcolor(4);

writeln(num);

TextColor(Black);

Write(' Ђ¤аҐб ');

Textcolor(4);

Writeln(adress);

{readkey;}

end;

end;

if Rez_Find then

Begin

Writeln;

Write(' Љ®«ЁзҐбвў® § ЇЁбҐ© ¤«п ’Ґ«Ґд®­  ');

readkey;

TextColor(4);Write(PhMask);Write(' - ');Writeln(CountRec);

TextColor(black);

End

else{if Rez_Find = false then}

Begin

Write(' ‡ ЇЁбм ¤«п ­®¬Ґа  ');

TextColor(4);Write(PhMask);

TextColor(Black);Writeln(' ­Ґ ­ ©¤Ґ­  ');

readkey;

end;

Close(BookFile);

end

else {if IOresult <> 0 then}

Writeln(' ” ©« : ',Name,' ­Ґв ­  ¤ЁбЄҐ ');

readkey;

end;

{****************************************************************************}

Procedure Findadress;

var

BookFile : file of RecBook;

Work : RecBook;

PhMask : adress;

Rez_Find : boolean;

CountRec : integer;

begin

{ Name_File;}

Work_Window;

Assign(BookFile, Name);

{$I-}

Reset(BookFile);

{$I+}

if IOresult = 0 then

begin

Write(' ‚ўҐ¤ЁвҐ  ¤аҐб ');

TextColor(4);

Readln(PhMask);

TextColor(Black);

Writeln;

Rez_Find := False;

CountRec := 0;

while (not Eof(BookFile)) do

begin

Read(BookFile,Work);

with Work do

if Pos(PhMask,adress) <> 0 then

begin

Rez_Find:= True;

Inc(CountRec);

textcolor(0);

Write(' ”.€.Ћ. ');

TextColor(4);

Writeln(Fio);

textcolor(0);

write(' Ќ®¬Ґа ⥫Ґд®­  ');

textcolor(4);

writeln(num);

textcolor(0);

Write(' Ђ¤аҐб ');

Textcolor(4);

Writeln(adress);

Writeln(' ');

{readkey;}

end;

end;

if Rez_Find then

Begin

Writeln;

Write(' Љ®«ЁзҐбвў® § ЇЁбҐ© ¤«п  ¤аҐб  ');

TextColor(4);Write(PhMask);Write(' - ');Writeln(CountRec);

TextColor(black);

readkey;

End

else{if Rez_Find = false then}

Begin

Write(' ‡ ЇЁбм ¤«п  ¤аҐб  ');

TextColor(4);Write(PhMask);

TextColor(Black);Writeln(' ­Ґ ­ ©¤Ґ­  ');

readkey;

end;

Close(BookFile);

end

else {if IOresult <> 0 then}

Writeln(' ” ©«: ',Name,' ­Ґ ­ ©¤Ґ­ ');

end;

{****************************************************************************}

Procedure FindCommon;

Begin

Vid := ' ';

Work_Window;

repeat

TextColor(Red);

Writeln(' ЊҐ­о Ї®ЁбЄ : ');

TextColor(Black);

Writeln(' €бЄ вм Ї®: ');

Writeln(' 1 ” ¬Ё«ЁЁ ');

Writeln(' 2 ’Ґ«Ґд®­г');

Writeln(' 3 Ђ¤аҐбг ');

Writeln(' 4 Ќ § ¤ ў Ј« ў­®Ґ ЊҐ­о');

TextColor(Lightred);

Readln(Vid);

Case Vid of

'1','”','д' : FindFio;

'2','ѓ','Ј' : findnum;

'4','Ђ',' ' : end_menu:= True;

'3','„','¤' : findadress;

End;

TextColor(Black);

{Writeln(' „«п Їа®¤®«¦Ґ­Ёп ­ ¦¬ЁвҐ Enter ');

Readln; }

ClrScr;

until End_Menu;

End_Menu := False;

End;

{-------------------------------global---------------------------------------}

BEGIN

ClrScr;

Work_Window;

{Name_File;}

Name:='BASA';

Vid := ' ';

End_Menu := False;

repeat

Curr_File;

Writeln;

TextColor(15);

Writeln(' Database volume 1 - Rus ');

Writeln(' Copyright (c) Konstantin Inc 15 nov 1998 ');

TextColor(0);

Writeln;

Writeln('*********************************************************************');

Writeln;

TextColor(Red);

Writeln('ЊҐ­о:');

TextColor(Black);

Writeln(' 1 C®§¤ вм ­®ўл© д ©«');

Writeln(' 2 Џа®б¬®ваҐвм ўбҐ ');

Writeln(' 3 PҐ¤ ЄвЁа®ў вм § ЇЁбм');

Writeln(' 4 „®Ў ўЁвм § ЇЁбм ');

Writeln(' 5 H ©вЁ');

Writeln(' 6 C¬e­Ёвм ⥪гйЁ© д ©«');

Writeln(' 7 Bл室');

write(' ');

TextColor(Lightred);

Readln(Vid);

case Vid of

'1','”','д' : Create_Book_Phone;

'2','Џ','Ї' : OutputAllRec;

'3','‡','§' : UpdateRec;

'4','„','¤' : AddRecToEnd;

'5','‰','©' : FindCommon;

'7','›','л' : End_Menu := true;

'6','…','Ґ' : Name_File;

end;

TextColor(Black);

{Writeln(' „«п Їа®¤®«¦Ґ­Ёп ­ ¦¬ЁвҐ Enter ');

Readln;}

ClrScr;

until End_Menu;

writeln(' ');

writeln(' Џа®Ја ¬¬­л© Їа®¤гЄв а §а Ў®в ­ ');

writeln(' ');

writeln(' б®ў¬Ґбв­л¬ “бвм-‹ ЎЁ­бЄ® - Њ ©Є®ЇбЄЁ¬ ᮤа㦥бвў®¬');

writeln(' ');

writeln(' " K®­бв ­вЁ­ & ‚ЁЄв®а"');

writeln(' ');

writeln(' ў «ЁжҐ ');

writeln(' ');

writeln(' ѓ аЎг§®ў  K®­бв ­вЁ­  Ё ‚ Єг«Ґ­Є® ‚ЁЄв®а . ');

writeln(' ');writeln(' ');writeln(' ');writeln(' ');writeln(' ');writeln(' ');

TextColor(lightred);

writeln(' Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг ');

readkey;

gotoxy(1,1);

END.

Программа написана студентом МГГТК группы 432

Гарбузовым Константином Сергеевичем

Программа предназначена для обучения начальных курсов методам программирования на языке Turbo Pascal, и в частности работе со строками.