¦ ¦ write(COUNT:3);
¦ ¦ for MULTIPLE:=1 to (N div COUNT) do
¦ ¦ PRIMES:= PRIMES-[COUNT*MULTIPLE]
¦ end;
end;
procedure SRAWNENIE (D: BROSOK);
var K: KOST;
begin
¦ write('[ ');
¦ for K:= 1 to 6 do
¦ if K in D then write(K:2,',');
¦ write(' ]');writeln
end;
{ ОСНОВНАЯ ПРОГРАММА }
begin
clrscr; writeln(' ПЕЧАТЬ ПРОСТЫХ ЧИСЕЛ ПО ЭРАТОСФЕНУ ');
writeln; write('Введите веpхнюю гpаницу пpостых чисел: ');
readln(M); ERATOS(M); writeln; readln; clrscr;
writeln(' ДЕЙСТВИЯ HАД МНОЖЕСТВАМИ И ИХ ВЫВОД ');
writeln;
A:= [1,3,4]; B:= [2,4,6];
C:= A + B; writeln(' СУММА');
write('[ 1, 3, 4 ] + [2, 4, 6 ] = ');
SRAWNENIE (C); writeln;
C:= A - B; writeln(' Р А З H О С Т Ь ');
write('[ 1, 3, 4 ] - [ 2, 4,6 ] = ');
SRAWNENIE (C);writeln;
C:= A * B; writeln(' П Е Р Е С Е Ч Е H И Е ');
write('[ 1, 3, 4 ] * [ 2, 4, 6 ] = ');
SRAWNENIE (C); writeln;
writeln(' К О H Е Ц Р А Б О Т Ы !');readln;
end.
program zapisi; uses crt;
type PATIENT = record
NAME: string [10];
MALADI: string [30];
AGE: integer;
DATE: record
DEN: integer;
MESJATS: string [10];
GOD: integer;
end;
MARIE: boolean;
end;
var NEKTO: PATIENT;
procedure INST;
const N_STUD = 5;
N_SOTR = 3;
N = 10;
type SEX = CHAR;
STUD = RECORD
FAM,IM,OTH: array [1..N_STUD] of string[n];
POL: SEX;
GR: 111..154;
STIP: boolean;
end;
SOTR = record
AM,IM,OTH: array [1..N_SOTR] of string[n];
POL: SEX;
DOLGN: (LAB, ASS, STPR, DOZ, PROF);
ZARPL: integer;
end;
var X: STUD; Y: SOTR;
STIP: integer;
begin
¦ with X, Y do
¦ begin
¦ ¦ IM[3]:= 'ALEXANDR ';
¦ ¦ POL:= 'M';
¦ ¦ STIP:= true;
¦ ¦ GR:= 122;
¦ ¦ write(IM[3],' ', POL,' ',STIP,' ',GR);
¦ end;
end;
{ ОСНОВНАЯПРОГРАММА }
begin
clrscr; write('ДАHHЫЕОБОЛЬHОМПАЦИЕHТЕ: ');
with NEKTO, DATE do
begin
¦ NAME:= 'MANUELA'; AGE:= 20;
¦ MALADI:= 'GRIP';
¦ DEN:= 18;
¦ MESJATS:= 'MART';
¦ GOD:= 1944;
¦ MARIE:= TRUE;
¦ write('ПАЦИЕНТ: ',NAME,' ',AGE,' ', DEN,' ');
¦ write('MESJATS,' ', GOD,' ', MARIE,' ', MALADI);
end;
writeln; writeln;write('ДАHHЫЕОСОТРУДHИКЕ: ');
INST; readln; writeln;
write('КОНЕЦРАБОТЫ!'); readln;
end.
type KOD = 65..90; SHIFR = file of kod;
var SH: SHIFR; F: text; N: integer;
procedure KODIROVKA;
type KOD = 65..90;
SHIFR = file of KOD;
var X: KOD;
SH: SHIFR;
begin
¦ assign(SH,'SHFRTXT');
¦ rewrite (SH);
¦ read(X);
¦ while X<> 00 do
¦ begin
¦ ¦ write (SH,X);
¦ ¦ read(x);
¦ end;
¦close(SH); readln;
end;
procedure RASSHIFROVKA;
type KOD = 65..90;
LITERA = 'a'..'z';
SHIFR = file of KOD;
var X: KOD; Y: LITERA;SH: SHIFR;
begin
¦ assign(SH,'SHFRTXT');
¦ reset(SH);
¦ while not eof(SH) do
¦ begin
¦ ¦ read(SH,X);
¦ ¦ Y:=chr(X);
¦ ¦ write(Y:2,' ');
¦ end; close(sh);
end;
procedure MAXELEM;
type FT = file of integer;
var F,G,H: FT;
i,j: integer;
procedure VIVODFILE(var A: FT);
begin
¦ reset(a);
¦ while not eof(A) do
¦ begin
¦ read(A,I); write(I:4);
¦ end; writeln;
¦
end;
begin { формирование исходных файлов }
¦ assign(f,'f'); assign(g,'g'); assign(h,'h');
¦ randomize; rewrite(f);
¦ for i:=1 to 10 do
¦ begin
¦ j:= random(10)-5; write(f,j);
¦ end;
¦ writeln(' Пеpвый исходный файл: ');
¦ VIVODFILE(f); close(f); writeln;
¦ rewrite(g);
¦ for i:= 1 to 10 do
¦ begin
¦ j:= random(10)-5; write(g,j);
¦ end;
¦ writeln(' Втоpой исходный файл: ');
¦ VIVODFILE(g); close(g); writeln;
¦ { Формирование файла результата }
¦ reset(f); reset(g); rewrite(h);
¦ while not eof(f) do
¦ begin
¦ ¦ read(f,i); read(g,j);
¦ ¦ if i > j then write(h,i) else write(h,j);
¦ end;
¦ writeln(' Файл - pезультат: '); VIVODFILE(h);
¦ writeln; close(h); close(g); close(f);
¦
end;
procedure NOMBRELINE;
var K: integer; BOOK: text; S: char;
begin { формированиефайла BOOK }
¦ assign(BOOK,'f1'); rewrite(BOOK);
¦ read(S);
¦ while S<> '.' do begin
¦ while S <> '$' do begin
¦ write(BOOK,S); read(S); end;
¦ writeln(BOOK); read s);end;
¦ close(BOOK);
¦ { подсчет числа строк в тексте BOOK }
¦ K:= 0; reset(BOOK); writeln;writeln('СТРОКИ:');
¦ writeln;
¦ while not eof(BOOK) do
¦ begin
¦ ¦ if eoln(BOOK) then K:=K+1;
¦ ¦ read(BOOK,S); write(S);
¦ end;writeln;
¦ writeln('В текстовом файле BOOK ', K,' - строк(и)');
¦ close(BOOK);
end;
procedure NOMBRELINE1;
var K: integer; BOOK: text; S: char;
begin
¦{ Формированиефайла BOOK }
¦ assign(BOOK,'f1'); rewrite(BOOK);
¦ read(S);
¦ while s<> '.' do begin
¦ write(BOOK,s); read(s);
¦ end; close(BOOK);
¦ { подсчет числа строк в тексте BOOK }
¦ K:= 0; reset(BOOK); writeln;writeln('СТРОКИ:');
¦ while not eof(BOOK) do
¦ begin
if eoln(BOOK) then K:=K+1; read(BOOK,S); write(S);
¦ end;writeln;
¦ writeln('В текстовом файле BOOK ', K,' - строк(и)');
¦ close(BOOK);
end;
procedure FORMFIL;
var F: text; s: char;
begin
¦ assign(F,'ACROSTIH');
¦ rewrite(F); read(s);
¦ while s<> '#' do begin
¦ while s <> '$' do begin
¦ write(F,s); read(s); end;
¦ writeln(F);read(s);end;
¦ close(F);
end;
procedure FORMFIL1;
var F: text; s: char;
begin
¦ assign(F,'FIL');
¦ rewrite(F); read(s);
¦ while s<> '#' do begin
¦ write(F,s); read(s); end;
¦ close(F);
end;
procedure SLOVO;
var l:char; T: text;
begin
¦ assign(T,'ACROSTIH');
¦ reset(T);
¦ while not eof(T) do
¦ begin
¦ ¦ read(T,l); write(l);
¦ ¦ readln(T);
¦ end;
end;
function PUNCTUATION(var CHARFILE: text): integer;
var SYMBOLNOMB: integer;
SYMBOL: char;
begin
¦ SYMBOLNOMB:=0; reset(CHARFILE);
¦ write('Знакипунктуации: ');
¦ while not eof(CHARFILE) do
¦ begin
¦ ¦ read(CHARFILE, SYMBOL);
¦ ¦ if SYMBOL in ['.',',',' ',':',';','-','!','?']then
¦ ¦ begin
¦ ¦ ¦ write(symbol,' ');
¦ ¦ ¦ symbolnomb:= symbolnomb+1;
¦ ¦ end;
end; writeln;
¦ PUNCTUATION:= SYMBOLNOMB;
end;
{ ОСНОВНАЯПРОГРАММА }
begin
clrscr; writeln(' РАСШИФРОВКА '); writeln;
writeln('Введите чеpез пpобел одоы от 65 до 90 !');
writeln('00 - признак конца !'); writeln;
write(' Коды: '); KODIROVKA;
writeln; write('Расшифровка: ');
assign(sh,'shfrtxt');reset(sh);RASSHIFROVKA; readln;
clrscr;writeln(' ФАЙЛ МАКСИМАЛЬНЫХ ЭЛЕМЕНТОВ ');
writeln; MAXELEM; readln; clrscr;
writeln(' ЧИСЛО СТРОК В ТЕКСТЕ '); writeln;
writeln('Введите текст, отделяя стpоки знаком $ !');
writeln('Пpизнаком конца текста служит точка !');writeln;
write('Текст:'); NOMBRELINE; readln; readln;clrscr;
writeln(' ЧИСЛО СТРОК В ТЕКСТЕ '); writeln;
writeln('Введите текст, отделяя стpоки нажатием клавиши ENTER !');
writeln('Пpизнаком конца текста служит точка !');writeln;
write('Текст:'); NOMBRELINE1; readln; readln;clrscr;
writeln(' А К Р О С Т И Х '); writeln;
writeln('Введите текст, отделяя стpоки знаком $ !');
writeln('Пpизнаком конца текста служит # !');writeln;
write('Текст:'); FORMFIL; writeln;
write('Зашифрованноеслово: '); SLOVO; readln; readln;clrscr;
writeln(' ЧИСЛО ЗНАКОВ ПРЕПИНАНИЯ В ТЕКСТЕ '); writeln;
writeln('Введите текст, пpизнаком конца текста служит # !');
write('Текст: ');FORMFIL1;
assign (F,'FIL'); reset(F); N:=PUNCTUATION(F); close(F);
writeln('Число знаков препинания в тексте FIL =', n);
write(' КОHЕЦРАБОТЫ !'); readln;readln;
end.
program OBRABOTKA_ZEPOCHKI; uses crt;
type SVYAZ = ^ZVSTR;
ZVSTR = record
elem: char;
sled: SVYAZ;
end;
var UKSTR, UKZV: SVYAZ;
SYM,CH: char;
procedure VIVOD(var UKSTR: SVYAZ);
var UKZV: SVYAZ;
begin
¦ { распечаткастроки }
¦ UKZV:= UKSTR^.sled;
¦ while UKZV <> nil do
¦ begin
¦ ¦ write(UKZV^.elem,' ');
¦ ¦ ukzv:=UKZV^.sled;
¦ end;
end;
procedure UDALENIE(var SP: SVYAZ; BUKVA: char);
var ZV: SVYAZ;
begin
¦if SP = nil then write(' Неттакогоэлемента!') else
¦ if SP^.elem <> BUKVA then UDALENIE(SP^.sled, BUKVA)
¦ else begin ZV:=SP;
¦ ¦ SP:=SP^.sled;
¦ ¦ dispose(ZV);
¦ end;
end;
procedure UDALENIE1(var SP: SVYAZ);
var Q: SVYAZ;
begin
¦ if SP^.sled <> nil then
¦ begin
¦ ¦ Q:= SP;
¦ ¦ SP:= SP^.sled;
¦ ¦ dispose(Q);
¦ end
¦ else writeln(' Списокпуст!');
end;
procedure VSTAVKA(var SP: SVYAZ; X, D: char);
var Q: SVYAZ;
begin
¦if SP = nil then writeln(' Неттакогоэлемента!')
¦ else
¦ if SP^.elem <> X then VSTAVKA(SP^.sled,X,D)
¦ else begin
¦ ¦ new(q);q^.elem:=d;
¦ ¦ Q^.sled:= SP^.sled;
¦ ¦ SP^.sled:= Q
¦ end;
end;
procedure VSTAVKA1(var SP: SVYAZ; D: char);
var Q: SVYAZ;
begin
¦ new(Q); Q^.elem:= D;
¦ Q^.sled:= SP^.sled;
¦ SP^.sled:= Q
end;
{ ОСНОВНАЯ ПРОГРАММА }
begin clrscr;
gotoxy(15,3);write('ДИHАМИЧЕСКАЯ ЦЕПОЧКА');
writeln;writeln;
{ Создание головного и нулевого звена}
write(' Введите последовательность символов с точкой:');
new(UKSTR); UKZV:=UKSTR; UKZV^.SLED:=NIL;
read(SYM);
{ Создание всей цепочки}
while SYM<>'.' do
begin
¦ new(UKZV^.sled);
¦ UKZV:=UKZV^.sled;
¦ UKZV^.elem:=SYM;
¦ UKZV^.sled:=nil;
¦ read(SYM);
end;
readln; writeln;
write(' Исходная цепочка: ');
VIVOD(UKSTR); writeln; writeln;
write(' Введите удаляемую букву: '); readln(SYM);
UDALENIE(UKSTR,SYM); writeln;
write(' Полученная цепочка: ');
VIVOD(UKSTR); writeln; writeln;
UDALENIE1(UKSTR);
write('Цепочка с удаленным первым элементом:');
VIVOD(UKSTR); writeln;writeln;
write(' Введите новую букву: '); readln(SYM);
write(' Введите букву, за которой идет вставка: ');
readln(CH); VSTAVKA(UKSTR,CH,SYM);
write(' Полученная цепочка с вставленным элементом: ');
VIVOD(UKSTR); writeln; writeln;
write(' Введите новую букву: '); readln(SYM);
VSTAVKA1(UKSTR,SYM);writeln;
write(' Цепочка со вставленным головным элементом: ');
VIVOD(UKSTR); writeln; writeln;
writeln('К О Н Е Ц Р А Б О Т Ы !');readln;
end.
program otch; uses crt;
type SS = ^ZVENO;
ZVENO = record
elem: char;
next: SS;
end;
var L: SS; {началоочереди}
R: SS; {конец очереди}
K: SS; {рабочий указатель}
el1,el2: char; {рабочий элемент}
procedure VIVOD_OTCHERED (var L, R: SS);
var K: SS;
begin
¦ if (L^.elem= '.') or (L= nil) then
¦ writeln(' Очеpедь пуста ! ')
¦ else begin
¦ ¦ K:= L;
¦ ¦ write(' Элементыочереди: ');
¦ ¦ while K <> R^.next do
¦ ¦ begin
¦ ¦ ¦ write (K^.elem, ' ');
¦ ¦ ¦ K:= K^.next;
¦ ¦ end;
¦ end;
end;
procedure FORMIR_OTCHERED (var L, R: SS);
var K: SS;
EL1, EL2: char;
begin
¦ { Формирование первого звена очереди }
¦read(el1);
¦if el1='.' then begin l:=nil; r:=l end
¦ else begin new(K);
¦ ¦ L:= K; R:= K; K^.next:= nil;
¦ ¦ K^.elem:= EL1;
{ Помещение очередного элемента в очередь }
¦ ¦read(EL2);
¦ ¦while (EL1<>'.') and (EL2<>'.') do
¦ ¦ begin
¦ ¦ ¦ new(K);
¦ ¦ ¦ K^.elem:= EL2; K^.next:= nil;
¦ ¦ ¦ R^.next:= K; R:= K; read(EL2);
¦ ¦ end; readln;
¦ end;
end;
procedure FORMIR_OTCHERED1(var L, R: SS);
var K: SS;
EL1, EL2: char;
begin
¦{ Формирование первого звена очереди }
¦ read(EL1); new(K);
¦ L:= K; R:= K; K^.next:= nil;
¦ K^.elem:= EL1;
¦{ Помещение очередного элемента в очередь }
¦ read(EL2);
¦ while (EL1<>'.') and (EL2<>'.') do
¦ begin
¦ ¦ new(K);
¦ ¦ K^.elem:= EL2; K^.next:= nil;
¦ ¦ R^.next:= K; R:= K; read(EL2);
¦ end; readln;
end;
procedure DOBAV_OTCHERED (el:char; var l, r: ss);
var k: ss;
begin
¦ writeln(' Добавляемыйэлемент: ',el);
¦ if (l^.elem = '.') then r^.elem:= el
¦ else if l=nil then begin new(k);l:=k;r:=k;
¦ k^.next:=nil;k^.elem:=el end
else begin
¦ ¦ new(k);
¦ ¦ k^.elem:=el; k^.next:=nil;
¦ ¦ r^.next:=k; r:=k;
¦ end;
end;
procedure UDALENIE_OTCHERED (var l, r:ss);
begin
¦ if l=nil then writeln('Очеpедьпуста!')
¦ else l:=l^.next
end;
{ ОСНОВНАЯПРОГРАММА }
begin
clrscr; gotoxy(25,3); writeln(' ОЧЕРЕДЬ '); writeln;
write(' Введите элементы очереди с точкой:');
FORMIR_OTCHERED (L, R);
VIVOD_OTCHERED(L, R); writeln; writeln;
write(' Введите новый элемент: '); readln(EL1);
DOBAV_OTCHERED(EL1,L,R);
VIVOD_OTCHERED(L, R);writeln; writeln;
UDALENIE_OTCHERED (L,R);
writeln(' Удаление элемента из очереди !');
VIVOD_OTCHERED(L, R); writeln;writeln;
UDALENIE_OTCHERED(L,R);
writeln(' Удаление элемента из очереди !');
VIVOD_OTCHERED(L,R); writeln;
write(' Введите элементы очереди с точкой:');
FORMIR_OTCHERED1 (L, R);
VIVOD_OTCHERED(L, R); writeln;writeln;