textbackground(9);gotoxy(pos(k,m),1);writeln(k);

Textbackground(0);

writeln('Фрагмент"',k,'"был найден начинвя с позиции',position:3)

End.

{87. Удалить из текста все буквы "о"}

Uses crt;

var word1,word: String;

dl,n:integer;

Label 1;

Begin

Clrscr;

writeln('Введите текст');

Readln(word1);

writeln('Введите букву, которую надо удалить');

Readln(word);

dl:=length(word1);

n:=pos(word,word1);

1:if n>0 then

Begin

Delete(word1,n,1);

insert(' ',word1,n);

dl:=length(word1);

if dl>0 then

Begin

n:=pos(word,word1);

Goto 1;

End

End;

Writeln(word1);

End.

{88. Составьте алгоритм и программу выбирающую из трех чисел то которое лежит между двумя другими }

Uses crt;

var a,b,c,low,high,mid:integer;

Begin;

Clrscr;

writeln('Введите три числа(после каждрого ENTER)');

Readln(a);

Readln(b);

Readln(c);

low:=a;

high:=a;

IF b < low THEN low:=b;

IF c < low THEN low:= c;

IF b > high THEN high := b;

IF c > high THEN high := c;

IF low=a THEN begin

if high=b then mid:=c;

if high=c then mid:=b;

End;

IF low=b THEN begin

if high=c then mid:=a;

if high=a then mid:=c;

End;

IF low=c THEN begin

if high=a then mid:=b;

if high=b then mid:=a;

End;

writeln('Между ',low,' и ', high,' лежит ', mid);

End.

{89. Сколько слов в тексте}

Uses crt;

var dl,ch,n:integer;

text,text1:string;

Label 1;

Begin

Clrscr;

writeln('Введите текст');

Readln(text);

ch:=1;

dl:=length(text);

n:=pos(' ',text);

1:if n>0 then

Begin

ch:=ch+1;

Delete(text,1,n);

dl:=length(text);

if dl>0 then

Begin

n:=pos(' ',text);

Goto 1;

End

End;

writeln('В предложениии ',ch,' слов(о) ');

End.

{90. Удалить из текста все цифры}

Uses crt;

var dl,ch,n,i:integer;

text,text1,c:string;

Label 1;

Begin

Clrscr;

writeln('Введите текст');

Readln(text);

dl:=length(text);

text1:='0123456789';

for i:=1 to 10 do

Begin

c:=copy(text1,i,1);

n:=pos(c,text);

1:if n>0 then

Begin

Delete(text,n,1);

insert(' ',text,n);

dl:=length(text);

if dl>0 then

Begin

n:=pos(c,text);

Goto 1;

End

End;

Writeln(text);

End.

{91. Вставить вместо пробелов точки}

Uses crt;

var dl,ch,n:integer;

text,text1:string;

Label 1;

Begin

Clrscr;

writeln('Введите текст');

Readln(text);

dl:=length(text);

n:=pos(' ',text);

1:if n>0 then

Begin

Delete(text,n,1);

insert('.',text,n);

dl:=length(text);

if dl>0 then

Begin

n:=pos(' ',text);

Goto 1;

End

End;

Writeln(text);

End.

{92 }

uses crt;

var dl,ch,n:integer;

text,text1,c:string;

Label 1;

Begin

Clrscr;

writeln('Введите текст');

Readln(text);

writeln('Введите для поиска первую букву слова');

Readln(text1);

dl:=length(text);

ch:=0;

c:=copy(text,1,1);

if c=text1 then ch:=ch+1;

n:=pos(' ',text);

1:if n>0 then

Begin

c:=copy(text,n+1,1);

if c=text1 then ch:=ch+1;

Delete(text,1,n);

dl:=length(text);

if dl>0 then

Begin

n:=pos(' ',text);

Goto 1;

End

End;

writeln(ch,' раз(а) слова начинаются на букву ',text1);

End.

{93. Напечатать фамилию победителя}

Uses crt;

var i,size,max:integer;

nam:array[1..10] of string;

bal:array[1..10] of integer;

Begin

Clrscr;

writeln('Сколько участников олимпиады');

Readln(size);

writeln('Максималтный балл');

Readln(max);

FOR i := 1 TO size do

Begin

Clrscr;

writeln('Фамилия участника');

readln(nam[i]);

writeln('Его балл');

readln(bal[i])

End;

Clrscr;

writeln('Участники');

FOR i := 1 TO size do

Begin

writeln(nam[i],' Балл ',bal[i]);

End;

FOR i := 1 TO size do

Begin

IF bal[i] = max THEN writeln(nam[i], ' победитель, баллов-',max);

End;

End.

{94. Напечатать фамилию чемпиона и его результат}

Uses crt;

var i,max,size:integer;

winer:string;

nam:array[1..10] of string;

bal:array[1..10] of integer;

Begin

Clrscr;

writeln('Введите кол-во участников соревнования');

Readln(size);

FOR i := 1 TO size do

Begin

Clrscr;

writeln('Фамилия участника');

readln(nam[i]);

writeln('Его балл');

readln(bal[i]);

End;

max := bal[1];

writeln('Участники');

FOR i := 1 TO size do

Begin

writeln(nam[i],' Балл ',bal[i]);

End;

FOR i := 1 TO size do

Begin

IF bal[i] > max THEN

Begin

max := bal[i]; winer:= nam[i];

End;

writeln(winer, ' победитель. Баллов ', max);

End.

{95. Посчитать общую стоимость товара}

Uses crt;

var numi,pricei,numii,priceii,numiii,priceiii,numiv,priceiv:integer;

Begin

Clrscr;

writeln('Введите количество и стоимость товаров I сорта кол-во и стоимость через Enter');

Readln(numi);

Readln(pricei);

Clrscr;

writeln('Введите количество и стоимость товаров II сорта кол-во и стоимость через Enter');

Readln(numii);

Readln(priceii);

Clrscr;

writeln('Введите количество и стоимость товаров III сорта кол-во и стоимость через Enter');

Readln(numiii);

Readln(priceiii);

Clrscr;

writeln('Введите количество и стоимость товаров IV сорта кол-во и стоимость через Enter');

Readln(numiv);

Readln(priceiv);

Clrscr;

writeln('сорт ', 'кол-во ', 'стоимость ед. ', 'общ.стоимость');

writeln('I ', numi, pricei:12, numi * pricei:24);

writeln('II ', numii, priceii:12, numii * priceii:24);

writeln('III ', numiii, priceiii:12, numiii * priceiii:24);

writeln('IV ', numiv, priceiv:12, numiv * priceiv:24);

writeln('Стоимость всех товаров ', numi * pricei + numii * priceii + numiii * priceiii + numiv * priceiv);

End.

{96. Занести в таблицу оценки учеников класса за год по математике и информатике}

Uses crt;

var i,k,size:integer;

nam:array[1..20] of string;

inf:array[1..20] of integer;

mat:array[1..20] of integer;

Begin

Clrscr;

writeln('Сколько учеников в классе');

Readln(size);

FOR i := 1 TO size do

Begin

Clrscr;

writeln('Введите фамилию ученика, оценку по мат., оценку по инф.');

readln(nam[i]);

readln(inf[i]);

readln(mat[i]);

End;

Clrscr;

writeln('Неуспевающие по информатике');

FOR i := 1 TO size do

Begin

IF inf[i] <= 2 THEN writeln(nam[i]);

End;

writeln('Неуспевающие по математике');

FOR i := 1 TO size do

Begin

IF mat[i] <= 2 THEN writeln(nam[i]);

End;

writeln('Отличники');

FOR i := 1 TO size do

Begin

IF (mat[i] = 5) AND (inf[i] = 5) THEN writeln(nam[i]);

End;

writeln('Общее число неуспевающих');

FOR i := 1 TO size do

Begin

IF (mat[i] = 2) OR (inf[i] = 2) THEN k := k + 1;

End;

Writeln(k);

End.

{97. Сформировать список учащихся сдавших экзамен на отлично}

Uses crt;

var i,size:integer;

nam:array[1..10] of string;

tick:array[1..10] of integer;

mark:array[1..10] of integer;

markp:array[1..10] of string;

Begin

Clrscr;

writeln('Введите кол-во учеников в классе');

Readln(size);

FOR i := 1 TO size do

Begin

Clrscr;

writeln('Введите фамилию ученика, билет, оценку цифрой, прописью (через ENTER)');

readln(nam[i]);

readln(tick[i]);

readln(mark[i]);

readln(markp[i]);

End;

Clrscr;

FOR i := 1 TO size do

Begin

writeln(nam[i],' Билет - ',tick[i],' Балл -',mark[i]);

End;

FOR i := 1 TO size do

Begin

IF (mark[i] = 5) AND (markp[i] = 'пять') THEN writeln(nam[i], ' билет № ', tick[i], mark[i]:2, ' (отлично)');

End;

End.

{98. Выбрать самого высоког ученика по данным из таблицы}

Uses crt;

var i,max,rr,vv,size:integer;

vnam1,vnam2:string;

nam1:array[1..10] of string;

nam2:array[1..10] of string;

r:array[1..10] of integer;

v:array[1..10] of integer;

Begin

Clrscr;

writeln('Введите кол-во учеников в классе');

Readln(size);

FOR i := 1 TO size do

Begin

Clrscr;

writeln('Введите фамилию ученика, имя, рост, вес через Enter');

readln(nam1[i]);

readln(nam2[i]);

readln(r[i]);

readln(v[i]);

End;

Clrscr;

max := r[1];

FOR i := 1 TO size do

Begin

IF r[i] > max THEN

Begin

vnam1 := nam1[i];

vnam2 := nam2[i];

rr := r[i];

vv := v[i];

max:=r[i];

End;

Clrscr;

writeln('самый высокий ученик');

writeln('Фамилия', 'Имя':10, 'Рост':10, 'Вес':10);

writeln(vnam1, vnam2:12, rr:12, vv:12);

End.