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;
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;
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;
End;
Clrscr;
writeln('самый высокий ученик');
writeln('Фамилия', 'Имя':10, 'Рост':10, 'Вес':10);
writeln(vnam1, vnam2:12, rr:12, vv:12);
End.
