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);