Текущий архив: 2003.06.09;
Скачать: CL | DM;

Вниз

Вычислить выражение, записаное в виде строки   Найти похожие ветки 

← →
Orcy   (2003-05-29 01:19) [0]

Помогите пожалуйста!!!
Срочно понадобилась прога, вычисляющая выражение, записаное в виде строки.
Нужно срочно, поэтому самом написать неуспею.

---

← →
Спрашивающий   (2003-05-29 02:27) [1]

Если утебя есть RxLib то
Цитата
Parsing unit:
function GetFormulaValue(const Formula: string): Extended;
Функция вычисляет результат математического выражения, заданного параметром Formula. Для вычислений используется объект типа TRxMathParser.

Пример
procedure TForm1.Button2Click(Sender: TObject);
begin
Text:=FloatToStr(GetFormulaValue(Edit1.Text));
end;

---

← →
___Nikolay ©   (2003-05-29 07:34) [2]

Длинное сообщение добавить сразу нельзя....
Поэтому вот первая часть:


unit MathComponent;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, math;

type
TMathtype = (mtnil, mtoperator, mtlbracket, mtrbracket, mtoperand);

type
TMathOperatortype = (monone, moadd, mosub, modiv, momul, mopow);

type
pmathchar = ^Tmathchar;
TMathChar = record
case mathtype: Tmathtype of
mtoperand:(data:extended);
mtoperator:(op:TMathOperatortype);
end;

type
TMathControl = class(TComponent)
private
input, output, stack: array of tmathchar;
fmathstring: string;
function getresult:extended;
function calculate(operand1,operand2,operator:Tmathchar):extended;
function getoperator(c:char):TMathOperatortype;
function getoperand(mid:integer;var len:integer):extended;
procedure processstring;
procedure convertinfixtopostfix;
function isdigit(c:char):boolean;
function isoperator(c:char):boolean;
function getprecedence(mop:TMathOperatortype):integer;
protected
published
property MathExpression:string read fmathstring write fmathstring;
property MathResult:extended read getresult;
end;

procedure register;

implementation

function Tmathcontrol.calculate(operand1,operand2,operator:Tmathchar):extended;
begin
result:=0;
case operator.op of
moadd:
result:=operand1.data + operand2.data;
mosub:
result:=operand1.data - operand2.data;
momul:
result:=operand1.data * operand2.data;
modiv:
if (operand1.data<>0) and (operand2.data<>0) then
result:=operand1.data / operand2.data
else
result := 0;
mopow:
result:=power(operand1.data, operand2.data);
end;
end;

function Tmathcontrol.getresult:extended;
var
i:integer;
tmp1,tmp2,tmp3:tmathchar;
begin
convertinfixtopostfix;
setlength(stack,0);
for i:=0 to length(output)-1 do
begin
if output[i].mathtype=mtoperand then
begin
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=output[i];
end
else
if output[i].mathtype=mtoperator then
begin
tmp1:=stack[length(stack)-1];
tmp2:=stack[length(stack)-2];
setlength(stack,length(stack)-2);
tmp3.mathtype:=mtoperand;
tmp3.data:=calculate(tmp2,tmp1,output[i]);
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=tmp3;
end;
end;
result:=stack[0].data;
setlength(stack,0);
setlength(input,0);
setlength(output,0);
end;

function Tmathcontrol.getoperator(c:char):TMathOperatortype;
begin
result:=monone;
if c="+" then
result:=moadd
else
if c="*" then
result:=momul
else
if c="/" then
result:=modiv
else
if c="-" then
result:=mosub
else
if c="^" then
result:=mopow;
end;

function Tmathcontrol.getoperand(mid:integer;var len:integer):extended;
var
i,j:integer;
tmpnum:string;
begin
j:=1;
for i:=mid to length(fmathstring)-1 do
begin
if isdigit(fmathstring[i]) then
begin
if j<=20 then
tmpnum:=tmpnum+fmathstring[i];
j:=j+1;
end
else
break;
end;
result:=strtofloat(tmpnum);
len:=length(tmpnum);
end;


---

← →
___Nikolay ©   (2003-05-29 07:35) [3]

а вот продолжение:


procedure Tmathcontrol.processstring;
var
i:integer;
numlen:integer;
begin
i:=0;
numlen:=0;
setlength(output,0);
setlength(input,0);
setlength(stack,0);
fmathstring:="("+fmathstring+")";
setlength(input,length(fmathstring));
while i<=length(fmathstring)-1 do
begin
if fmathstring[i+1]="(" then
begin
input[i].mathtype:=mtlbracket;
i:=i+1;
end
else
if fmathstring[i+1]=")" then
begin
input[i].mathtype:=mtrbracket;
i:=i+1;
end
else
if isoperator(fmathstring[i+1]) then
begin
input[i].mathtype:=mtoperator;
input[i].op:=getoperator(fmathstring[i+1]);
i:=i+1;
end
else
if isdigit(fmathstring[i+1]) then
begin
input[i].mathtype:=mtoperand;
input[i].data:=getoperand(i+1,numlen);
i:=i+numlen;
end;
end;
end;


function Tmathcontrol.isoperator(c:char):boolean;
begin
result:=false;
if (c="+") or (c="-") or (c="*") or (c="/") or (c="^") then
result:=true;
end;

function Tmathcontrol.isdigit(c:char):boolean;
begin
result:=false;
if ((integer(c)> 47) and (integer(c)< 58)) or (c=".") then
result:=true;
end;

function Tmathcontrol.getprecedence(mop:TMathOperatortype):integer;
begin
result:=-1;
case mop of
moadd: result := 1;
mosub: result := 1;
momul: result := 2;
modiv: result := 2;
mopow: result := 3;
end;
end;

procedure Tmathcontrol.convertinfixtopostfix;
var
i,j,prec:integer;
begin
processstring;
for i:=0 to length(input)-1 do
begin
if input[i].mathtype=mtoperand then
begin
setlength(output,length(output)+1);
output[length(output)-1]:=input[i];
end
else
if input[i].mathtype=mtlbracket then
begin
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=input[i];
end
else
if input[i].mathtype=mtoperator then
begin
prec:=getprecedence(input[i].op);
j:=length(stack)-1;
if j>=0 then
begin
while(getprecedence(stack[j].op)>=prec) and (j>=0) do
begin
setlength(output,length(output)+1);
output[length(output)-1]:=stack[j];
setlength(stack,length(stack)-1);
j:=j-1;
end;
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=input[i];
end;
end
else
if input[i].mathtype=mtrbracket then
begin
j:=length(stack)-1;
if j>=0 then
begin
while(stack[j].mathtype<>mtlbracket) and (j>=0) do
begin
setlength(output,length(output)+1);
output[length(output)-1]:=stack[j];
setlength(stack,length(stack)-1);
j:=j-1;
end;
if j>=0 then
setlength(stack,length(stack)-1);
end;
end;
end;
end;

procedure register;
begin
RegisterComponents("Samples", [TMathControl]);
end;

end.


---

← →
Calm ©   (2003-05-29 09:00) [4]

В кладовке есть класс, вычисляющий выражения. Умеет еще кое-чего полезного. Называется Recognizer. Сам использовал - работает надежно.

---

Страницы: 1 вся ветка

Текущий архив: 2003.06.09;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.021 c