home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / math.swg / 0050_Math Parsing Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-09-26  |  4.0 KB  |  139 lines
  1. (*
  2. From: RYAN THOMPSON
  3. Subj: RE: MATH PARSING
  4. *)
  5.  
  6. Function Evaluate(Equation : String) : String;
  7.   Var
  8.     Temp, Operand, Front, Rear : String;
  9.     X, Y, Par1, Par2 : Integer;
  10.     Value1, Value2, Valtemp : Real;
  11.     OperOK,
  12.     BadExp : Boolean;
  13.   Begin
  14.     If Equation = Error then begin
  15.       Evaluate:= Error;
  16.       Exit;
  17.     end;
  18.     While Pos(' ', Equation) > 0 do
  19.       Delete(Equation, Pos(' ', Equation), 1);
  20.     repeat
  21.       X:= 1;
  22.       Par1:= 0;
  23.       Par2:= 0;
  24.       repeat
  25.           If Equation[X] = '(' then Par1:= X;
  26.           If Equation[X] = ')' then Par2:= X;
  27.           Inc(X);
  28.       until (X = Length(Equation) + 1) or ((Par1 > 0) and (Par2 > 0));
  29.       If (Par2 > 0) and (Par2+1 < Length(Equation)) and
  30.            (Equation[Par2 + 1] = '(')
  31.       then Insert('x', Equation, Par2 + 1);
  32.       If (Par2 > Par1) then begin
  33.           Temp:= Equation;
  34.           Rear:= Copy(Temp, Par2 + 1, 255);
  35.          Delete(Temp, Par2, 255);
  36.          Front:= Copy(Temp, 1, Par1 - 1);
  37.           Delete(Temp, 1, Par1);
  38.         Temp:= Evaluate(Temp);
  39.         Equation:= Front + Temp + Rear;
  40.         While Pos(' ', Equation) > 0 do
  41.           Delete(Equation, Pos(' ', Equation), 1);
  42.       end
  43.       else if Par2 < Par1 then begin
  44.          Evaluate:= Error;
  45.         Exit;
  46.       end;
  47.     until Par2 <= Par1;
  48.     Value1:= 0;
  49.     repeat
  50.       If (Length(Equation) > 0) then begin
  51.         Operand:= '';
  52.       X:= 1;
  53.       While ((Equation[X] < '0') or (Equation[X] > '9'))
  54.             and (Equation[X] <> '.')
  55.             and (X < Length(Equation) + 1)
  56.       do begin
  57.         Operand:= Operand + Equation[X];
  58.         Inc(X);
  59.       end;
  60.          Delete(Equation, 1, X - 1);
  61.     end;
  62.     If Length(Equation) > 0 then begin
  63.         Temp:= '0';
  64.       X:= 1;
  65.       while (((Equation[X] <= '9') and (Equation[X] >= '0'))
  66.             or (Equation[X] = '.')) and (X < Length(Equation) + 1) do
  67.       begin
  68.           Temp:= Temp + Equation[X];
  69.         Inc(X);
  70.          end;
  71.         If (X > 10) and (Pos('.', Equation) > 9) then begin
  72.           Evaluate:= Error;
  73.           Exit;
  74.       end;
  75.       Delete(Equation, 1, X - 1);
  76.       Val(Temp, Value2, Y);
  77.       If Y <> 0 then begin
  78.         Evaluate:= Error;
  79.         Exit;
  80.       end;
  81.     end;
  82.     Temp:= '';
  83.     If Length(Operand) > 1 then begin
  84.       Temp:= Operand;
  85.          Delete(Temp, Pos('+', Temp), 1);
  86.         If Pos('-', Temp) <> Length(Temp)
  87.       then Delete(Temp, Pos('-', Temp), 1);
  88.       Delete(Temp, Pos('x', Temp), 1);
  89.       Delete(Temp, Pos('/', Temp), 1);
  90.       Delete(Temp, Pos('^', Temp), 1);
  91.       If Pos('+', Operand) = 1 then Operand:= '+'
  92.       else if Pos('-', Operand) = 1 then Operand:= '-'
  93.       else if Pos('x', Operand) = 1 then Operand:= 'x'
  94.         else if Pos('/', Operand) = 1 then Operand:= '/'
  95.       else if Pos('^', Operand) = 1 then Operand:= '^'
  96.       else Operand:= '';
  97.     end;
  98.     OperOK:= False;
  99.     If Temp = 'SIN' then begin
  100.       OperOK:= True;
  101.       Value2:= Sin(Rad(Value2));
  102.     end;
  103.     If Temp = 'COS' then begin
  104.         OperOK:= True;
  105.         Value2:= Cos(Rad(Value2));
  106.     end;
  107.     If Temp = 'TAN' then if Cos(Rad(Value2)) <> 0 then begin
  108.         OperOK:= True;
  109.         Value2:= (Sin(Rad(Value2)) / Cos(Rad(Value2)));
  110.     end
  111.     else begin
  112.         Evaluate:= Error;
  113.         Exit;
  114.     end;
  115.     If Temp = 'SQR' then begin
  116.         OperOK:= True;
  117.         Value2:= Sqrt(Value2);
  118.     end;
  119.     If Temp = 'ASIN' then begin
  120.         OperOK:= True;
  121.         Valtemp:= 1 - Sqr(Value2);
  122.          If Valtemp < 0 then begin
  123.            Evaluate:= Error;
  124.            Exit;
  125.          end
  126.          else If Sqrt(Valtemp) = 0 then Value2:= 90
  127.          else Value2:= Deg(ArcTan(Value2 / Sqrt(Valtemp)));
  128.     end;
  129.     If Temp = 'ACOS' then begin
  130.       OperOK:= True;
  131.       Valtemp:= 1 - Sqr(Value2);
  132.          If Valtemp < 0 then begin
  133.            Evaluate:= Error;
  134.         Exit;
  135.          end
  136.          else If Value2 = 0 then Value2:= 90
  137.          else Value2:= Deg(Arctan(Sqrt(Valtemp) / Value2))
  138.     end;
  139.