Программа
PROGRAM Calculator;
CONST NumChar=['0'..'9']; { Множество цифровых символов }
PlusChar=['-','+']; { Множество символов представляющих
операции типа сложения и унарные операции }
VAR St:string;{ Строка выражения }
Error:boolean; { Флаг ошибки }
PROCEDURE MoveSubStr(var St:string; StartPos:byte; var SubStr:string;var Error:boolean);
{ Процедура выделения подстроки выражения в скобках }
Var FinishPos:byte; { Последний символ подстроки }
MeterBracket:byte; { Счетчик скобок }
Begin
FinishPos:=StartPos; { Начальное определение конца подстроки }
MeterBracket:=1; { Начальное определение счетчика скобок }
while (FinishPos<Length(St))and(MeterBracket>0) do { Цикл просмотра строки }
begin
Inc(FinishPos); { Переопределение конца подстроки }
if St[FinishPos]='('
then Inc(MeterBracket) { Набор открывающих скобок }
else if St[FinishPos]=')'
then Dec(MeterBracket) { Сброс открывающих скобок }
else
end;
if MeterBracket>0 { Проверка количества открытых скобок }
then Error:=TRUE { Установка флага ошибки }
else begin
SubStr:=Copy(St,StartPos+1,FinishPos-StartPos-1); { Копирование подстроки }
Delete(St,StartPos,FinishPos-StartPos+1) { Удаление подстроки }
end
End;
PROCEDURE GetRightNum(var St:string;Pos:byte; var Num:longint; var Error:boolean);
{ Процедура получения правого от Pos операнда }
Var Sign:-1..1; { Знак операнда }
Begin
Inc(Pos); { Сдвиг на следующую после знака операции позицию }
Sign:=1; { Начальное опредделение знака операнда }
while (Pos<=Length(St))and(St[Pos] in PlusChar) do
begin { Цикл определения знака операнда (унарные: +/-) }
if St[Pos]='-' then Sign:=-Sign; { Инверсия знака }
Delete(St,Pos,1) { Удаление знака }
end;
if St[Pos] in NumChar { Проверка корректности операнда }
then begin
Num:=0; { Начальное определение операнда }
while (Pos<=Length(St))and(St[Pos] in NumChar) do
begin { Цикл набора операнда }
Num:=Num*10+(Ord(St[Pos])-Ord('0')); { Набор операнда }
Delete(St,Pos,1) { Удаление символа }
end;
Num:=Sign*Num { Учет знака операнда }
end
else Error:=TRUE { Установка флага ошибки }
End;
PROCEDURE GetLeftNum(var St:string;var Pos:byte; var Num:longint; var Error:boolean);
{ Процедура получения левого от Pos операнда }
Var Power:longint; { Разряд набираемого операнда }
Begin
Power:=1; { Начальная установка разряда }
Num:=0; { Сброс операнда }
while (Pos>1)and(St[Pos-1]in NumChar) do { Цикл набора операнда }
begin
Dec(Pos); { Смещение на шаг влево по строке }
Num:=Num+Power*(Ord(St[Pos])-Ord('0')); { Набор операнда }
Power:=Power*10; { Пересчет разрядного множителя }
Delete(St,Pos,1) { Удаление текущего символа }
end;
if Power=1 then Error:=TRUE { Подъем флага ошибки }
End;
PROCEDURE Multiplication(var St:string; Pos:byte; var Error:boolean);
{ Процедура вычисления простых подвыражений типа умножения }
Var NumLeft,NumRight,Result:longint; { Левый и правый операнды и результат операции }
Buf:string; { Буферная строка }
Begin
GetLeftNum(St,Pos,NumLeft,Error); { Получение левого операнда }
GetRightNum(St,Pos,NumRight,Error); { Получение правого операнда }
if not Error then { Проверка корректности получения операндов }
begin
if St[Pos]='*' { Определение операции }
then Result:=NumLeft*NumRight { Умножение }
else Result:=NumLeft div NumRight; { Деление }
Delete(St,Pos,1); { Удаление знака операции }
Str(Result,Buf); { Преобразование результата }
Insert(Buf,St,Pos) { Вставка результата в строку }
end
End;
PROCEDURE Summing(var St:string;var Error:boolean); { Процедура набора суммы }
Var Sum,Add:longint; { Набранная сумма и слагаемое }
Begin
Sum:=0; { Сброс суммы }
if St='' then Error:=TRUE; { Установка ошибки }
while (St<>'')and not Error do { Цикл набора суммы }
begin
GetRightNum(St,0,Add,Error); { Получение первого слагаемого в строке }
Sum:=Sum+Add { Набор суммы }
end;
Str(Sum,St) { Запись результата в исходную строку }
End;
PROCEDURE Corrector(var St:string); { Процедура корректировки строки }
Var i:byte; { Счетчик }
Begin
i:=2; { Начальное определение счетчика }
while i<Length(St) do { Цикл просмотра строки }
begin
if St[i]='(' { Если текущий символ - открывающая скобка }
then if St[i-1] in NumChar { то - если предыдущий символ - цифра }
then Insert('*',St,i) { то - вставка символа '*' }
else
else if St[i]=')' { иначе - если текущий символ ')' }
then if St[i+1] in (NumChar+['(']) { то - если следующий символ цифра или '(' }
then Insert('*',St,i+1) { то - вставка символа '*' }
else
else;
Inc(i) { Переопределение счетчика символов }
end
End;
FUNCTION Min(a,b:byte):byte; { Функция выбора наименьшего ненулевого числа }
Begin
if (a<b)and(a>0) { Сравнение чисел межде собой и с нулем }
{ Определение значения функции: }
then Min:=a
else if b>0
then Min:=b
else Min:=a
End;
FUNCTION GetNumSt(St:string; var Error:boolean):string;
{ Процедура получения значения строки }
Var SubSt:string; { Подстрока арифметического выражения }
SubPosition:byte; { Позиция арифметической под строки }
Begin
while (Pos('(',St)>0)and not Error do { Цикл исключения выражений в скобках }
begin
SubPosition:=Pos('(',St); { Определение начальной позиции подстроки }
MoveSubStr(St,SubPosition,SubSt,Error); { Выделение подстроки }
Insert(GetNumSt(SubSt,Error),St,SubPosition); { Вставка результата в исходную строку }
end;
while ((Pos('*',St)>0)or(Pos('/',St)>0))and not Error do { Цикл вычисления опереаций '*' и '/' }
Multiplication(St,Min(Pos('*',St),Pos('/',St)),Error); { Выполнение операции '*' или '/' }
if not Error then Summing(St,Error); { Выполнение операций +/- }
if Error { Проверка флага ошибки }
{ Определение значения функции: }
then GetNumSt:='Ошибка'
else GetNumSt:=St
End;
BEGIN
Error:=FALSE; { Сброс флага ошибки }
WriteLn; { Пропуск строки }
WriteLn('Введите арифметическое выражение'); { Вывод приглашения }
ReadLn(St); { Чтение строки }
Corrector(St); { Алгебраическая корректировка строки }
WriteLn('=',GetNumSt(St,Error)) { Вычисление и вывод значения }
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию