Тема №9843 Ответы к задачам по информатике Паскаль 98 (Часть 2)
Поиск задачи:

Рассмотрим тему Ответы к задачам по информатике Паскаль 98 (Часть 2) из предмета Информатика и все вопросы которые связанны с ней. Из представленного текста вы познакомитесь с Ответы к задачам по информатике Паскаль 98 (Часть 2), узнаете ключевые особенности и основные понятия.

Уважаемые посетители сайта, если вы не согласны с той информацией которая представлена на данной странице или считаете ее не правильной, не стоит попросту тратить свое время на написание негативных высказываний, вы можете помочь друг другу, для этого присылайте в комментарии свое "правильное" решение и мы его скорее всего опубликуем.

{55 Сделать все элементы таблицы равными заданному числу}
uses crt;
var x,y,xx,yy,a:integer;
begin;
clrscr;
writeln('Введите число');
readln(a);
writeln('Введите размер таблицы x и y через Enter');
readln(x);
readln(y);
clrscr;
FOR xx := 1 TO x do
begin
FOR yy := 1 TO y do
begin
gotoxy(yy, xx); writeln(a);
end;
end;
end.
сяца продавец доставлялна дом 4 л молока в день. В марте молоко стоило х руб за литр Спервого апреля цена молока увеличилась до [x+a] руб за литр Сколько надо заплатить продавцу за все доставленное молоко в конце апреля? Кол-во покупаемого молока осталось прежним}
uses crt;
var march,april,payment:real;
begin;
clrscr;
writeln('Введите стоимость отпускаемого молока в марте');
readln(march);
writeln('Введите стоимость отпускаемого молока в апреле');
readln(april);
payment:= march * 4 * 31 + april * 4 * 30;
writeln('Вы должны заплатить с 1-го марта по 30-е апреля включительно ',payment:7:2, ' руб.')
end.
{56 }
uses crt;
var x,y,i,j,s:integer;
begin
clrscr;
writeln('Введите размер таблицы (x,y)');
readln(x);
readln(y);
clrscr;
for i:=1 to x do;
for j:=1 to y do;
s(i,j):=(j+(i-1)*y)*(j+(i-1)*y);
locate i*2,j*4: writeln(s(i,j));
next j;
next i;
end.
{57 }
uses crt;
var x,y,i,j,s:integer;
begin
clrscr;
writeln('Введите размер таблицы (x,y)');
readln(x);
readln(y);
clrscr;
for i:=1 to x do;
for j:=1 to y do;
s(i,j):=(j+(i-1)*y)*2;
locate i*2,j*4: writeln(s(i,j));
next j;
next i;
end.
{58. }
uses crt;
var i,k,pol,numberofpol,chplace,plus,zero,minus,forabout:integer;
a:array[1..10000] of integer;
begin
clrscr;
write ('Введите размер массива ');
read(i);
begin
writeln('Введите элементы массива');
FOR k := 1 TO i do
begin
readln(a[k]);
end;
FOR k := 1 TO i do
IF a[k] > 0 THEN
begin
pol := pol + a[k]; numberofpol := numberofpol + 1;
end;
end;
writeln('Среднее арифмет.положительных элементов равно ', pol / numberofpol:7:2);
writeln('Среднее арифмет. элементов на отрезке [1,2] равно', (a[1] + a[2]) / 2:7:2);
FOR k := 1 TO i do
begin
IF a[k] > 0 THEN plus := plus + 1;
IF a[k] = 0 THEN zero := zero + 1;
IF a[k] < 0 THEN minus := minus + 1;
end;
writeln('Положительных ', plus, ' отрицательных ', minus, ' равных нулю ', zero);
FOR k := 1 TO i do
begin
IF round(a[k]) = 1 THEN forabout := forabout + 1;
end;
writeln('Элементов приближенно равных 1 насчитано ', forabout);
end.
{59. Сформировать массив из положительных элементов}
uses crt;
var i,k,pr,size,max:integer;
b:array[1..10] of integer;
a:array[1..10] of integer;
begin;
clrscr;
pr:= 1;
writeln('Введите размер массива');
readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
begin
readln(b[i]);
end;
begin
IF b[i] > 0 THEN
begin
k := k + 1;
a[k] := b[i];
end;
end;
FOR i := 1 TO k do
begin
pr := pr * a[i];
end;
writeln('Произведение положительных эл.массива ', pr);
writeln('Cформираванный массив A(I):');
FOR i := 1 TO k do
begin
writeln(a[i]);
end;
end.
{60. Заменить все элементы массива стоящие до максимального нулями}
uses crt;
var i,size,num,max:integer;
a:array[1..10000] of integer;
begin;
ClrScr;
writeln('Введите размер массива');
readln(size);
FOR i := 1 TO size do
begin
clrscr;
writeln('Введите элементы массива');
readln(a[i]);
end;
max := a[1];
clrscr;
writeln('Введенный массив');
FOR i := 1 TO size do
begin
writeln(a[i]);
IF a[i] > max THEN
begin
num := i-1;
max:=a[i];
end
end;
FOR i := 1 TO num do
begin
a[i] := 0;
end;
writeln('Сформированный массив');
FOR i := 1 TO size do
begin
writeln (a[i]);
end;
end.
{62. Заменить все элементы массива стоящие после минимального нулями}
uses crt;
var i,size,min,num:integer;
a:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива');
readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
begin
readln(a[i]);
end;
min := a[1];
FOR i := 2 TO size do
begin
IF a[i] < min THEN
begin
num := i + 1;min:=a[i];
end;
end;
FOR i := num TO size do
begin
a[i] := 0;
end;
writeln('Сформированный массив:');
FOR i := 1 TO size do
begin
writeln(a[i]);
end;
end.
{63. Определить сколько элементов массива <,>,= X}
uses crt;
var x,i,size,more,less,mid:integer;
a:array[1..10000] of integer;
begin
CLrscr;
writeln('Введите размер массива');
readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
begin
readln(a[i])
end;
writeln('Введите число x');
readln(x);
FOR i := 1 TO size do
begin
IF a[i] > x THEN more := more + 1;
IF a[i] < x THEN less := less + 1;
IF a[i] = x THEN mid := mid + 1;
end;
writeln('Больше числа Х в массиве элементов ',more);
writeln('Меньше числа Х в массиве элементов ',less);
writeln('Равных числу Х в массиве элементов ', mid);
end.
{64. Сколько в массиве Т(м) элементов меньших суммы всех элементов}
uses crt;
var i,size,summa,num:integer;
t:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива');
readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
begin
readln(t[i]);
end;
FOR i := 1 TO size do
begin
summa := summa + t[i];
end;
FOR i:= 1 TO size do
begin
IF t[i] < summa THEN num := num + 1;
end;
writeln('В массиве элементов меньше суммы всех элементов ', num);
end.
{65. Напечатать сумму, произведение и номера полож элементов после последнего нулевого элемента }
uses crt;
var i,size,num,summa,pr,k:integer;
x:array[1..10000] of integer;
n:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива');
readln(size);
FOR i := 1 TO size do
begin
clrscr;
writeln('Введите элементы массива');
readln(x[i]);
end;
writeln('Введенный массив');
FOR i := 1 TO size do
begin
writeln(x[i]);
IF x[i] = 0 THEN num := i;
end;
if num=0 then
begin
writeln('Нулевые элементы не найдены');
halt;
end;
pr := 1;
FOR i := num + 1 TO size do
begin
IF x[i] > 0 THEN
begin
summa := summa + x[i]; pr := pr * x[i]; k := k + 1; n[k] := i;
end;
end;
writeln('Номера положительных элементов после последнего 0');
FOR i := k TO size do
begin
writeln(n[i]);
end;
writeln('Сумма положительных элементов после последнего 0 равна ', summa);
writeln('Произведение положительных элементов после последнего 0 равна ', pr);
end.
{66. Найти сумму и кол-во элементов в массиве Т после первого нулевого элемента}
uses crt;
var i,num,size,summa,k:integer;
t:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива');
readln(size);
FOR i := 1 TO size do
begin
clrscr;
writeln('Введите элементы массива');
readln(t[i]);
end;
writeln('Введенные элементы');
for i:=1 to size do
begin
writeln(t[i]);
end;
FOR i := 1 TO size do
begin
IF t[i] = 0 THEN
num := i;
FOR k := num + 1 TO size do
begin
summa := summa + t[k];
end;
writeln('Сумма элементов после первого 0 равна ', summa);
writeln('Количество элементов после первого 0 равна ', size - i);
halt;
end;
end.
{67. Напечатать сумму отрицательных элементов массива А после первого нулевого элемента}
uses crt;
var i,size,num,summa:integer;
a:array [1..10000] of integer;
label 1;
begin;
clrscr;
writeln('Введите размер массива');
readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
begin
readln(a[i]);
end;
FOR i := 1 TO size do
begin
IF a[i] = 0 THEN
begin
num := i; GOTO 1;
end;
end;
1:
FOR i := num + 1 TO size do
begin
IF a[i] < 0 THEN summa := summa + a[i];
end;
writeln('Сумма отрицательных элементов после первого 0 равна ', summa);
end.
{68 Вывести номер координаты пункта В наиболее удаленного от пункта А}
uses crt;
var maxx,maxy,i,m,x,y,n:integer;
bx:array[1..1000] of integer;
by:array[1..1000] of integer;
bx1:array[1..1000] of integer;
by1:array[1..1000] of integer;
begin;
clrscr;
writeln('Введите координаты пункта А(x и y через Enter) ');
readln(x);
readln(y);
writeln('Введите количество пунктов В');
readln(m);
clrscr;
FOR i := 1 TO m do
begin
gotoxy(1,1);writeln('Введите координаты пунктов B(x и y через Enter)');
readln(bx[i]);
readln(by[i]);
end;
FOR i := 1 TO m do
begin
bx1[i] := SQR(bx[i]*bx[i]);
by1[i] := SQR(by[i]*by[i]);
IF (bx1[i] > x) AND (by1[i] > y) AND (bx1[i] > maxx) AND (by1[i] > maxy) THEN
begin
maxx := bx1[i]; maxy := by1[i]; n := i;
end;
end;
clrscr;
writeln('Точка A ',x,',',y);
writeln('Точки B ');
for i:=1 to m do
begin
writeln(bx[i],',',by[i]);
end;
writeln('Наиболее удалена точка с координатами ', bx[n], ',', by[n]);
end.
{69. Найти общее кол-во нулевых элементов в массивах Х(м) У(к)}
uses crt;
var i,m,k,num,numm,nn:integer;
x:array[1..10000] of integer;
y:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива x(m)');
readln(m);
writeln('Введите размер массива y(k)');
readln(k);
writeln('Введите элементы массива x(m)');
FOR i := 1 TO m do
begin
readln(x[i]);
end;
writeln('Введите элементы массива y(k)');
FOR i := 1 TO k do
begin
readln(y[i]);
end;
FOR i := 1 TO m do
begin
IF x[i] = 0 THEN num := num + 1;
end;
FOR i := 1 TO k do
begin
IF y[i] = 0 THEN numm := numm + 1;
end;
if num>numm then nn:=numm else nn:=num;
writeln('Общее количество нулевых элементов в двух массиваx ', nn);
end.
{70. Напечатать число элементов в массиве Т}
uses crt;
var i,m,k,num:integer;
x:array[1..10000] of integer;
t:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива x(m)');
readln(m);
FOR i := 1 TO m do
begin
clrscr;
writeln('Введите элементы массива x(m)');
readln(x[i]);
clrscr;
end;
writeln('Введенный массив');
FOR i := 1 TO m do
begin
writeln (x[i]);
IF x[i] >= 0 THEN
begin
num := num + 1; k := k + 1; t[k] := x[i];
end;
end;
writeln('Сформированный массив');
FOR i := 1 TO k do
begin
writeln (t[i]);
end;
writeln('Количество элементов в сформированном массиве ', num);
end.
{71. Вывести четные числа среди положительных элементов}
uses crt;
var i,m:integer;
x:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива x(m)');
readln(m);
writeln('Введите элементы массива x(m)');
FOR i := 1 TO m do
begin
readln(x[i]);
end;
clrscr;
gotoxy(5,6);writeln('Четные среди положительных элементов массива');
FOR i := 1 TO m do
begin
IF (x[i] > 0) AND (x[i] / 2 = INT(x[i] / 2)) THEN
begin
gotoxy(i*3+5,8); writeln( x[i]); end;
gotoxy(i*3+5,10);writeln(x[i]);
end;
end.
{72. Удвоить наибольший элемент массива Х(м)}
uses crt;
var max,i,size,k:integer;
x:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива');
readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
begin
readln(x[i]);
end;
max := x[1];
FOR i := 2 TO size do
begin
IF x[i] > max THEN
begin
max := x[i]; k := i;
end;
end;
x[k] := max * 2;
writeln('Массив с удвоенным максимальным элементом');
FOR i := 1 TO size do
begin
writeln (x[i]);
end;
end.
{73. Вывести ненулевые элементы массива Х(м) и их произведение}
uses crt;
var size,i,pr:integer;
x:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива');
readln(size);
writeln('Введите элементы массива');
FOR i := 1 TO size do
begin
readln(x[i]);
end;
pr := 1;
writeln('Ненулевые элементы массива');
FOR i := 1 TO size do
begin
IF x[i] <> 0 THEN
begin
writeln(x[i]); pr := pr * x[i];
end;
end;
writeln('Их произведение ',pr);
end.
{74. Вывести положительные элементы массива Х(к) затем отрицать элементы массива У(м) и кол-во выведенных чисел}
uses crt;
var m,num,i,k:integer;
x:array[1..10000] of integer;
y:array[1..10000] of integer;
begin
clrscr;
writeln('Введите размер массива x(k)');
readln(k);
writeln('Введите размер массива y(m)');
readln(m);
writeln('Введите элементы массива x(k)');
FOR i := 1 TO k do
begin
readln(x[i]);
end;
writeln('Введите элементы массива y(m)');
FOR i := 1 TO m do
begin
readln(y[i]);
end;
writeln('Положительные элементы массива x(k)');
FOR i := 1 TO k do
begin
IF x[i] > 0 THEN
begin
writeln (x[i]);
num := num + 1;
end;
end;
writeln('Отрицательные элементы массива y(m)');
FOR i := 1 TO m do
begin
IF y[i] < 0 THEN
begin
writeln(y[i]); num := num + 1;
end;
end;
writeln('Количество выведенных элементов ', num);
end.
{75. Найти число элементов массива Т мньших С }
uses crt;
var m,i,c,summa,num:integer;
t:array[1..10000] of integer;
begin
clrscr;
writeln('Введите размер массива t(m)');
readln(m);
writeln('Введите число C');
readln(c);
writeln('Введите элементы массива t(m)');
FOR i := 1 TO m do
begin
readln(t[i]);
end;
FOR i := 1 TO m do
begin
IF t[i] > c THEN
begin
summa := summa + t[i]; num := num + 1;
end;
end;
writeln('Среднее арифметическое элементов больше C равно ', summa / num:7:2);
writeln('Количество элементов меньше С равно ',m - num);
end.
{76. Произвести перестановку массива}
uses crt;
var m,x,i,k:integer;
a:array[1..10000] of integer;
a2:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива a(m)');
readln(m);
writeln('Введите число x');
readln(x);
FOR i := 1 TO m do
begin
clrscr;
writeln('Введите элементы массива a(m)');
readln(a[i]);
end;
clrscr;
writeln('Введенный массив');
FOR i := 1 TO m do
begin
writeln(a[i]);
IF a[i] < x THEN
begin
k := k + 1; a2[k] := a[i];
end;
end;
FOR i := 1 TO m do
begin
IF a[i] = x THEN
begin
k := k + 1; a2[k] := a[i];
end;
end;
FOR i := 1 TO m do
begin
IF a[i] > x THEN
begin
k := k + 1; a2[k] := a[i]
end;
end;
writeln('Сформированный массив');
FOR i := 1 TO m do
begin
writeln (a2[i]);
end;
end.
{77. Образовать третий массив из элементов встречающихся в обоих массивах}
uses crt;
var m,k,i,l,c:integer;
a:array[1..10000] of integer;
b:array[1..10000] of integer;
ab:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива a(m)');
readln(m);
writeln('Введите размер массива b(k)');
readln(k);
clrscr;
writeln('Введите элементы массива a(m)');
FOR i := 1 TO m do
begin
readln(a[i]);
end;
writeln('Введите элементы массива b(k)');
FOR i := 1 TO m do
begin
readln(b[i]);
end;
FOR i := 1 TO m do
begin
FOR l := 1 TO k do
begin
IF a[i] = b[l] THEN
begin
c := c + 1; ab[c] := a[l];
end;
end;
end;
clrscr;
writeln('Массив образованный из одинаковых элементов');
FOR i := 1 TO c do
begin
writeln (ab[i]);
end;
end.
{78. Поменять местами макс и мин элементы}
uses crt;
var i,size,max,min,num,num1:integer;
a:array[1..10000] of integer;
begin
clrscr;
writeln('Bведите размер массива');
readln(size);
FOR i := 1 TO size do
begin
clrscr;
writeln('Введите элементы массива');
readln(a[i]);
end;
max := a[1];
min := a[1];
clrscr;
writeln('Введенный массив');
FOR i := 1 TO size do
begin
writeln(a[i]);
IF a[i] > max THEN
begin
num := i; max := a[i];
end;
end;
FOR i := 1 TO size do
begin
IF a[i] < min THEN
begin
num1 := i; min := a[i];
end;
end;
a[num1 + 1] := max;
a[num] := min;
writeln('Массив, где max и min поменяли местами');
FOR i := 1 TO size do
begin
writeln(a[i]);
end;
end.
{79. Поменять местами макс и последний элемент }
uses crt;
var i,max,num,size:integer;
a:array[1..10000] of integer;
begin;
clrscr;
writeln('Введите размер массива');
readln(size);
FOR i := 1 TO size do
begin
clrscr;
writeln('Введите элементы массива');
readln(a[i])
end;
max := a[1];
clrscr;
writeln('Введенный массив');
FOR i := 1 TO size do
begin
writeln(a[i]);
IF a[i] > max THEN
begin
num := i; max := a[i];
end;
end;
a[num] := a[size];
a[size] := max;
writeln('Массив, где max и последний элемент поменяли местами');
FOR i := 1 TO size do
begin
writeln (a[i]);
end;
end.
{80 Сколько раз во втором слове встречается первая буква первого слова}
uses crt;
var x,x1,i,c,dl,ch,n:integer;
word,word1,k:string;
label 1;
begin
clrscr;
writeln('Введите первое слово');
readln(word);
writeln('Введите второе слово');
readln(word1);
dl:=length(word1);
k:=copy(word,1,1);
ch:=0;
n:=pos(k,word1);
1:if n>0 then
begin
ch:=ch+1;
Delete(word1,1,n);
dl:=length(word1);
if dl>0 then
begin
n:=pos(k,word1);
goto 1;
end
end;
writeln('Во втором слове буква ',k,' встречается ',ch,' раз(а)');
end.
{81. }
uses crt;
var n:integer;
begin
clrscr;
writeln('Введите 0 или 2');
readln(n);
if n=0 then
begin
writeln('БУКВА И ЗВУК');
end
else writeln('БУКВА И БАБОЧКА');
end.
{82.}
uses crt;
var st0,st1,st2,st3,st4,st5,st6,st7,st8,st9,ST10,ST11,st12,d:string;
begin
clrscr;
writeln('БАЛКОН');
writeln(' ');
st0:='БАЛКОН';
st1:=copy(st0,3,1);
st2:=copy(st0,5,1);
st3:=copy(st0,1,1);
d:=st1+st2+st3;
writeln(d);
st4:=copy(st0,4,1);
st5:=copy(st0,3,1);
st6:=copy(st0,2,1);
st7:=copy(st0,6,1);
d:=st4+st5+st6+st7;
writeln(d);
st8:=copy(st0,4,1);
st9:=copy(st0,5,1);
st10:=copy(st0,3,1);
st11:=copy(st0,1,1);
st12:=copy(st0,2,1);
d:=st8+st9+st10+st11+st12;
writeln(d);
end.
{83}
uses crt;
var st0,st1,st2,st3,st4,st5,st6,st7,st8,st9,ST10,ST11,st12,d:string;
begin
clrscr;
writeln('ШУТКА');
writeln(' ');
st0:='ШУТКА';
st1:=copy(st0,1,1);
st2:=copy(st0,2,1);
st3:=copy(st0,3,1);
d:=st1+st2+st3;
writeln(d);
st4:=copy(st0,2,1);
st5:=copy(st0,3,1);
st6:=copy(st0,4,1);
st7:=copy(st0,5,1);
d:=st4+st5+st6+st7;
writeln(d);
st8:=copy(st0,3,1);
st9:=copy(st0,2,1);
st10:=copy(st0,1,1);
st11:=copy(st0,4,1);
st12:=copy(st0,5,1);
d:=st8+st9+st10+st11+st12;
writeln(d);
end.
{84. Составить программу для подсчета числа букв А Б В в предложении}
uses crt;
var a,b,c,x,y:integer;
dl,ch,n,cha,chb,chv:integer;
text,text1:string;
aa,bb,vv,cc:char;
label 1,2,3;
begin
clrscr;
writeln('какие символы будем считать(a,b,c-через Enter)');
readln(aa);
readln(bb);
readln(vv);
writeln('Введите текст');
readln(text);
dl:=length(text);
text1:=text;
cha:=0;
chb:=0;
chv:=0;
n:=pos(aa,text);
1:if n>0 then
begin
cha:=cha+1;
Delete(text1,1,n);
dl:=length(text1);
if dl>0 then
begin
n:=pos(aa,text1);
goto 1;
end
end;
text1:=text;
n:=pos(bb,text1);
2:if n>0 then
begin
chb:=chb+1;
Delete(text1,1,n);
dl:=length(text1);
if dl>0 then
begin
n:=pos(bb,text1);
goto 2;
end
end;
text1:=text;
n:=pos(vv,text1);
3:if n>0 then
begin
chv:=chv+1;
Delete(text1,1,n);
dl:=length(text1);
if dl>0 then
begin
n:=pos(vv,text1);
goto 3;
end
end;
writeln('В предложениии ',aa,' встречается ',cha,' раз(а) ');
writeln('В предложениии ',bb,' встречается ',chb,' раз(а) ');
writeln('В предложениии ',vv,' встречается ',chv,' раз(а) ');
end.
{85 Поставить буквы в алфавитном порядке}
uses crt;
var dl,ch,n,i,k:integer;
text,alf,c,sim,buk:string;
d:array[1..32] of integer;
label 1;
begin
clrscr;
writeln('Введите текст');
readln(text);
dl:=length(text);
alf:='абвгдежзийклмнопрстуфхцчшщъыьэюя';
clrscr;
for k:=1 to 32 do
d[k]:=0;
for i:=1 to dl do
begin
sim:=copy(text,i,1);
for k:=1 to 32 do
begin
buk:=copy(alf,k,1);
if sim=buk then
d[k]:=d[k]+1;
end;
end;
for i:=1 to 32 do
begin
if d[i]<>0 then
begin
gotoxy(i*2+5,15);
writeln(alf[i]);
gotoxy(i*2+5,18);
writeln(d[i]);
end
end;
gotoxy(5,13);
writeln(text);
end.
{86. Найти в тексте подстроку "авс"}
uses crt;
var m:string[79];
k:string[79];
i:integer;
position:byte;
procedure Search;
begin
Position:=pos(k,m);
IF position<>0 then sound(100);delay(10);nosound;
end;
begin;
textbackground(0);
clrscr;
writeln('Введите предложение');
readln(m);
writeln('Какие символы следует найти');
readln(k);
clrscr;
search;
writeln(m);
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;
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.

 

 


Категория: Информатика | Добавил: Админ (23.11.2016)
Просмотров: | Рейтинг: 0.0/0


Другие задачи:
Всего комментариев: 0
avatar