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