Решение

Пока в строке присутствуют знаки умножения, мы находим первый из них. Выделяем числа, стоящие слева и справа, удаляем соответствующуе часть строки (число, знак умножения, число) и вставляем на это же место результат умножения выделенных чисел друг на друга. Остальные действия выполняются по порядку. Корректность введенного выражения будет проверена по ходу вычислений.

Program Example_135;

var pq, p1, p2: string;

m,n, k, l, j: word;

Begin

writeln('Введите арифметическое

выражение');

readln(pq);

while pos('*', pq)>0 do

{цикл для выполнения всех

действий умножения}

Begin

p1:=' ';

k:=pos('*', pq);

while (k>1) and (pq[k-1]

in ['0'..'9']) do

Begin

k:=k-1;

p1:=pq[k]+p1 {формируем число,

стоящее справа от знака умножения}

end; {while}

p2:=' ';

l:=pos('*', pq);

while (l<length(pq)) and (pq[l+1]

in ['0'..'9']) do

Begin

l:=l+1;

p2:=p2+pq[l]; {формируем число,

стоящее справа от знака умножения}

end; {while}

val(p1, n, j);

if j>0 then

Begin

writeln('ошибка в выражении');

halt

end; {if}

val(p2, m, j);

if j>0 then

Begin

writeln('ошибка в выражении);

halt;

end; {if}

j:=m*n;

str(j, p1);

delete(pq, k, l-k+1);

{часть строки удаляем}

insert (p1, pq, k);

{вставляем результат умнож.}

end; {while} {все умножения выполнены}

while (pos('+',pq)>0) or

(pos('-',pq)>0) do

Begin

p1:=' ';

k:=1;

while (pq[k] in ['0'..'9']) do

Begin

p1:=p1+pq[k];

k:=k+1;

end; {while}

p2:=' ';

l:=k;

while (l<length(pq)) and (pq[l+1]

in ['0'..'9']) do

Begin

l:=l+1;

p2:=p2+pq[l];

end; {while}

val(p1, n, j);

if j>0 then

Begin

writeln('ошибка в выражении');

halt;

end; {if}

val(p2, m, j);

if j>0 then

Begin

writeln('ошибка в выражении');

halt;

end; {if}

case pq[k] of

'+': j:=n+m;

'-': j:=n-m;

end; {case}

str(j, p1);

delete(pq, 1, l);

insert(p1, pq, 1)

end; {while}

{все сложения и вычитания выполнены}

val(pq, n, j);

if j>0 then

Begin

writeln('ошибка в выражении');

halt;

end; {if}

writeln('=', pq);

readln;

End.

Оператор halt − стандартная процедура, которая завершает выполнение программы и выполняет возврат в операционную систему.

Пример 8

Подсчитать, сколько букв а в тексте.

ProgramExample_136;

uses crt;

var a: string;

i, s: integer;

Begin

clrscr;

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

readln(a);

s:=0;

for i:=1 to length(a) do

Begin

if (copy (a, i, 1)= 'a') or

(copy(a, i, 1)= 'A') then

s:=s+1;

end;

writeln('В заданном тексте буква <a>

встречается ', s, ' раза');

End.

Пример 9

Найти сумму двух целых чисел, которые вводятся с клавиатуры, а также сумму цифр каждого из цифр.

Program Example_137;

uses crt;

var a, b, c1, c2, i, k, s, sa, sb: integer;

ca, cb: string[5];

Begin

clrscr;

s:=0; sa:=0; sb:=0;

write('Задайте 1-е число'); readln(a);

write('Задайте 2-е число'); readln(b);

s:=a+b;

str(a, ca); str(b, cb);

for i:=1 to length(ca) do

Begin

val(copy(ca, i, 1), c1, k);

sa:=sa+c1;

end;

for i:=1 to length(cb) do

Begin

val(copy(cb, i, 1), c2, k);

sb:=sb+c2;

end;

writeln(' Сумма чисел равна ',s);

writeln(' Сумма цифр 1-го числа= ', sa)

writeln(' Сумма цифр 2-го числа= ', sb);

readln;

End.

Пример 10

Определить, каких цифр в числе больше: четных или нечетных.

ProgramExample_138;

uses crt;

var a: string[5];

b: string[1];

i, k, s, sn, x: integer;

Begin

clrscr;

s:=0; sn:=0

write('Задайте число'); readln(a);

for i:=1 to length(a) do

Begin

b:=copy(a, i, 1);

val(b, x, k);

if x mod 2=0 then s:=s+1

else sn:=sn+1;

end;

if s>sn then

writeln('четных цифр больше');

if s<sn then

writeln('нечетных цифр больше');

if s=sn then writeln('Одинаково');

End.