Для передвижения по тексту используются клавиши управления курсором
и клавиши 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('L===========================================================-');
gotoxy(10, 2); write(' В текущем каталоге нет файла ', s, '. ');
gotoxy(15, 3); write(' Без него не могу работать. ');
textbackground(1); gotoxy(27, 5); write(' Да '); c: =chr(1); {
выдаёт звукавой сигнал } music; while(cchr(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('L==================================-'); 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(cchr(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 begin
readln(f, s); if (s[1]='#')and(s[2]='#')and(s[3]='#') then break;
textf[m]: =s; if m m: =m+1; end; x: =m; c: =chr(1); m: =0; while
cchr(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+231) 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('L'); 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(cchr(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('L===========================================================-');
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('L===========================================================-');
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 doserror0
then begin myerror('curswork. txt'); halt(1); end; findfirst('help.
txt', anyfile, di); if doserror0 then begin myerror('help. txt');
halt(1); end; findfirst('about. txt', anyfile, di); if doserror0
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, и в частности работе со
строками.