Программа


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.

Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию