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