Mir war fad
Erkläuterung:
Code:
o Punkt vor Strich wird beachtet
o +-*/ kann er sehr gut lösen
o Klammern () werden unterstützt
evt buggy:
o Potenzieren via ^ möglich
o Wurzel ziehen XsY -> 9s2 --> 3
EDIT
Math Unit wird benötigt
Aufruf könnte wie "ShowMessage( SolveProblem( Edit1.Text ) )" folgen
EDIT #n
Es sind keine Fehlerbehandlungen mit eingebaut worden:
Fehler:
- doppelte Operatoren
- Klammer offen vergessen
- "4+2-" ...
So das ist mein letzter Edit heute ...
Wünsch euch allen eine gute Nacht
Code:
Delphi-Quellcode:
var
Operators: Set of Char = [' s', ' ^',' +', ' -', ' *', ' /'];
Clamp: Set of Char = [ ' (', ' )', #8];
Numbers: Set of Char = [ ' 0'..' 9' ];
function SolveProblem( Problem: String ): String;
var
newProblem: String;
x, t: Word; // x = pos, solution, ...
Solution: Single;
function OperatorInString(Buf: String): Boolean;
begin
Result := True;
if Pos(' s', Buf) = 0 then
if Pos(' ^', Buf) = 0 then
if Pos(' *', Buf) = 0 then
if Pos(' /', Buf) = 0 then
if Pos(' +', Buf) = 0 then
if Pos(' -', Buf) = 0 then
Result := False;
end;
// x3+3 --> x = left | startpos = +
function GetLeft(P: String; StartPos: Word): Word;
var
x: Word;
begin
x := StartPos-1;
while (P[x] in Numbers) and (x>=1) do
dec(x);
if x = 0 then
Result := 1
else
Result := x+1;
end;
// 3+3x --> x = left | startpos = +
function GetRight(P: String; StartPos: Word): Word;
var
x: Word;
begin
x := StartPos+1;
while (P[x] in Numbers) and (x<=Length(P)) do
inc(x);
Result := x;
end;
{leftcompo+12}
function GetLeftComponent(P: String): Single;
var
x: Word;
begin
x := Pos( ' s', LowerCase(P) );
if x = 0 then
x := Pos( ' ^', P );
if x = 0 then
x := Pos( ' *', P );
if x = 0 then
x := Pos( ' /', P );
if x = 0 then
x := Pos( ' +', P );
if x = 0 then
x := Pos( ' -', P );
if x = 0 then
Result := x
else
result := StrToFloat( Copy( P, 1, x-1 ) );
end;
{123+rightcompo}
function GetRightComponent(P: String): Single;
var
x: Word;
begin
x := Pos( ' s', LowerCase(P) );
if x = 0 then
x := Pos( ' ^', P );
if x = 0 then
x := Pos( ' *', P );
if x = 0 then
x := Pos( ' /', P );
if x = 0 then
x := Pos( ' +', P );
if x = 0 then
x := Pos( ' -', P );
if x = 0 then
Result := x
else
result := StrToFloat( Copy( P, x+1, Length(p) ) );
end;
{ (1*3*5+3+2 ..) }
function SolveThatProblems( var P: String ): Single;
var // 3*5*6+5*6
Sqrt, Sqr,
Dot, _Div,
Plus, Minus,
x, y: Word;
c1, c2: Single;
buf: String;
begin
Minus := 0;
Sqr := Pos( ' ^', P );
if Sqr = 0 then
Sqrt := Pos( ' s', LowerCase(P) );
if Sqrt = 0 then
Dot := Pos( ' *', P );
if Dot = 0 then
_Div := Pos( ' /', P );
if _Div = 0 then
Plus := Pos( ' +', P );
if Plus = 0 then
Minus := Pos( ' -', P );
if (Sqr > 0) then
begin
x := GetLeft(P, Sqr);
y := GetRight(P, Sqr);
end else
if (Sqrt > 0) then
begin
x := GetLeft(P, Sqrt);
y := GetRight(P, Sqrt);
end else
if (Dot > 0) then
begin
x := GetLeft(P, Dot);
y := GetRight(P, Dot);
end else
if (_Div > 0) then
begin
x := GetLeft(P, _Div);
y := GetRight(P, _Div);
end else
if (Plus > 0) then
begin
x := GetLeft(P, Plus);
y := GetRight(P, Plus);
end else
if (Minus > 0) then
begin
x := GetLeft(P, Minus);
y := GetRight(P, Minus);
end else
begin
Result := 0;
Exit;
end;
buf := copy( P, x, y-x );
c1 := GetLeftComponent( buf );
c2 := GetRightComponent( buf );
if Sqr > 0 then
Result := Power( c1, c2 )
else
if Sqrt > 0 then
Result := Power( c1, 1/c2 )
else
if Dot > 0 then
Result := c1*c2
else
if _Div > 0 then
Result := c1/c2
else
if Plus > 0 then
Result := c1+c2
else
if Minus > 0 then
Result := c1-c2;
delete( P, x, y-x );
Insert( FloatToStr(Result), P, x );
if OperatorInString(P) then
SolveThatProblems(P)
else
Result := StrToFloat(P);
end;
function KlammerEnde(buf: String): Word;
var
kAufs, kZus: Word;
i: Integer;
begin
kAufs := 0;
kZus := 0;
for i := 1 to Length(buf) do
begin
if buf[i] = ' (' then
inc(kAufs)
else
if buf[i] = ' )' then
begin
inc(kZus);
if kAufs-kZus=0 then
begin
Result := i;
Exit;
end;
end;
end;
end;
begin
x := Pos(' (', Problem);
if x > 0 then
begin
newProblem := Copy( Problem, x+1, KlammerEnde(Problem)-x-1 ); // ausdruck in klammern
Delete( Problem, x, Length(NewProblem)+2 );
Insert( SolveProblem( newProblem ), Problem, x);
x := Pos( ' (', Problem );
if x > 0 then
Problem := SolveProblem( Problem ); // löse werte in einer klammer auf
end;
if OperatorInString( Problem ) then
SolveThatProblems( Problem );
Result := Problem;
end;
MfG
|