Вход

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

Реферат по программированию
Дата добавления: 26 марта 1999
Язык реферата: Русский
Word, rtf, 227 кб
Реферат можно скачать бесплатно
Скачать
Не подходит данная работа?
Вы можете заказать написание любой учебной работы на любую тему.
Заказать новую работу




Для передвижения по тексту используются клавиши управления курсором и клавиши 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, и в частности работе со строками.



© Рефератбанк, 2002 - 2017