вот сам модуль, если можно как-то оптимизировать
unit unit1;
interface
procedure DelElem(var arr: array of char; i: integer);
procedure DelElemnum(var arr: array of real; i: integer);
function Kalkulator(orig: string): real;
function NUM1(orig: string): real;
implementation
procedure DelElem(var arr: array of char; i: integer);
var
j: integer;
begin
for j := i to length(arr) - 2 do
arr[j] := arr[j + 1];
setlength(arr, length(arr) - 1);
end;
procedure DelElemnum(var arr: array of real; i: integer);
var
j, h: integer;
cop: array of real;
begin
setlength(cop, length(arr) - 1);
for j := 0 to length(cop) - 1 do
if j <> i then
begin
cop[j] := arr[j];
end
else
begin
h := j;
break;
end;
for j := h to length(cop) - 1 do
cop[j] := arr[j + 1];
setlength(arr, length(cop));
arr := cop;
end;
function Kalkulator(orig: string): real;
label 1;
var
Tarr: array of char;
cop: string;
num: array of real;
i, h, g, po, p, j: integer;
perem: string;
res: real;
bool: boolean;
begin
cop := orig; res := 0; h := 0; p := 0; g := -1; po := 0;
for i := 1 to length(cop) do
if (cop[i] = '*') or (cop[i] = '/') or (cop[i] = '+') or (cop[i] = '-') then //проверка на существование знаков *, / , - , +
begin
setlength(tarr, h + 1); //если есть то заносим их в массив-Tarr
tarr[h] := cop[i];
po := g + 2;//определяем начало и
p := i - 1;//конец значений позийций числа
perem := '';
perem := copy(orig, po, p - po + 1);//записываем число ввиде строки в Perem
setlength(num, h + 1);//добавляем это число в массив
if trystrtofloat(perem, num[h]) = false then
begin
writeln('Невозможно считать строку убедитеть что ввели все без ошибок и повторите еще раз');//Если нельзя то выводим сообщение об ошибке
result := 0;
exit;
end;
g := p;
h := h + 1;
end;
setlength(num, h + 1);//Из за особенности пердыдущего кода последняя цифра не считвыется ,этот код для нее
po := g + 2;
p := length(orig);
perem := copy(orig, po, p - po + 1);
num[h] := strtofloat(perem); //разбор на состовляюшие
if length(tarr) = 1 then //ели у нас одна операция то переходим к ее выполнению т.е к метке 1
goto 1;
repeat //решаем умножение и деление
if length(tarr) = 0 then
goto 1;// если в примере было только умножение или деление то перходим в метке 1
for i := 0 to length(tarr) - 1 do
case tarr[i] of
'*':
begin
unit1.DelElem(tarr, i); //удаляем символ из массива
res := num[i] * num[i + 1];//решаем
unit1.DelElemnum(num, i); //заменяем 2 множителя на их произведение
num[i] := res;
bool := false; //показывает что в массиве еще могут быть знаки * и /
break;
end;
'/':
begin
res := num[i] / num[i + 1]; //аналогично множению
unit1.DelElem(tarr, i);
unit1.DelElemnum(num, i);
num[i] := res; bool := false;
break;
end
else
bool := true;// в массиве нету * и /
end;
until bool <> false;
1: //метка 1
result := num[0];//досчитвываем получившиеся числа
if length(tarr) <> 0 then
begin
for i := 0 to length(tarr) - 1 do
case tarr[i] of
'+': result := result + num[i + 1];
'-': result := result - num[i + 1];
'*': result := result * num[i + 1];
'/': result := result / num[i + 1];
end
end;
end;
function NUM1(orig: string): real;//функция для рашение примеров со скобками
var
cop: string;
bool: boolean;
res: real;
Re: string;
i, j, lan, k, g: integer;
begin
repeat
bool := true;
for i := 1 to length(orig) do
if orig[i] = '(' then //если есть скобка то ищщем ее конец
begin
k := i;
for j := k to length(orig) do
if orig[j] = ')' then
begin
Re := copy(orig, i + 1, j - i - 1);//привер в скобках отдаем решать функции Kalkulator
lan := length(re) + 2;
delete(orig, i, lan);//удаляем скобки и то что между ними ----------------------------
inc(g); // |
res := unit1.Kalkulator(Re); // |
if (g = 1) and (i = 1) then //если это скобка стоит в начале то (1+2)+6 = 3+6 |
orig := floattostr(res) + orig // |
else // |
begin{если нет то 6++12= так как мы удаляем скобки и то что между ними ------------
6 + = копируем все что стояло после скобок в cop
6 + = удаляем это
6+3= добваляем результат в скобках
6+3+12 и переменную сор }
cop := copy(orig, i, length(orig) - i + 1);
delete(orig, i, length(orig) - i + 1);
orig := orig + floattostr(res) + cop;
end;
bool := false;//показывет что еще есть скобки
break;
end
else
begin
bool := true;//что скобок нет
end;
break;
end
else
if i = length(orig) then
begin
bool := true;//что скобок нет
break;
end;
until bool = true;
result := Kalkulator(orig);//передаем полученные числа функции Kalkulator
end;
begin
end.