calculate.pas

Calculate delphi 7&6

        // if we find an open paren, make the recursive call
        if expression[current_pos] = '(' then begin
            // did we find a function?
            if (current_pos > 1) AND (not (expression[current_pos - 1] in delimiters)) then begin
                Inc(current_pos);
                if FParams = nil then FParams := TStringList.Create;
                FParams.Clear;
                FParams.Insert(0, Calculate(expression));
                tokens[tokens.Count - 1] := HandleFunction(tokens[tokens.Count - 1]);
                Inc(current_pos); // move past the ')' at the end of the function
            end
            else begin
                Inc(current_pos);
                tokens[tokens.Count - 1] := (Calculate(expression));
                Inc(current_pos); // move past the previous ')';
            end;
        end
        else if expression[current_pos] = ',' then begin
            Inc(current_pos);
            FParams.Insert(0, Calculate(expression));
        end
        else if expression[current_pos] <> ')' then begin
            // needed in case two delimiters are encountered in succession
            // i.e. a negative assertion ( 1 - -2 )
            if tokens[tokens.Count - 1] = '' then tokens.Delete(tokens.Count - 1);

            // now add the current delimeter
            tokens.Add(expression[current_pos]);
            Inc(current_pos);
        end;
    end;

    // search for negative assertions
    delim_pos := 0;
    while delim_pos < tokens.Count - 1 do begin
        if CompareStr(tokens[delim_pos],'-') = 0 then begin
            if delim_pos = 0 then begin tokens.delete(delim_pos); tokens[delim_pos] := '-' + tokens[delim_pos]; end
            else if (Length(tokens[delim_pos-1]) = 1) AND (tokens[delim_pos-1][1] in delimiters) then begin tokens.delete(delim_pos); tokens[delim_pos] := '-' + tokens[delim_pos]; end;
        end;
        Inc(delim_pos);
    end;

    // now check for the power operation
    delim_pos := tokens.IndexOf('^');
    while delim_pos > 0 do begin
        tokens.Insert(delim_pos -1, doCalc(ord(tokens[delim_pos][1]), tokens[delim_pos - 1], tokens[delim_pos + 1]));
        tokens.Delete(delim_pos); tokens.Delete(delim_pos); tokens.Delete(delim_pos);
        delim_pos := tokens.IndexOf('^');
    end;

    // now check for multiply, divide, modulous operations
    delim_pos := MinPositiveIntValue([tokens.IndexOf('*'), tokens.IndexOf('/'), tokens.IndexOf('%')]);
    while delim_pos > 0 do begin
        tokens.Insert(delim_pos -1, doCalc(ord(tokens[delim_pos][1]), tokens[delim_pos - 1], tokens[delim_pos + 1]));
        tokens.Delete(delim_pos); tokens.Delete(delim_pos); tokens.Delete(delim_pos);
        delim_pos := MinPositiveIntValue([tokens.IndexOf('*'), tokens.IndexOf('/'), tokens.IndexOf('%')]);
    end;

    // now check for add or subtract operations
    delim_pos := MinPositiveIntValue([tokens.IndexOf('+'), tokens.IndexOf('-')]);
    while delim_pos > 0 do begin
        tokens.Insert(delim_pos -1, doCalc(ord(tokens[delim_pos][1]), tokens[delim_pos - 1], tokens[delim_pos + 1]));
        tokens.Delete(delim_pos); tokens.Delete(delim_pos); tokens.Delete(delim_pos);
        delim_pos := MinPositiveIntValue([tokens.IndexOf('+'), tokens.IndexOf('-')]);
    end;

    Result := Trim(tokens.Text);
    tokens.Free;
end;

function Tcalculate.doCalc(operation : Integer; left_side, right_side : String) : String;
var
    float_right_side : Extended;
begin
    // watch for divide by zero..
    float_right_side := FindFloat(right_side);
    if ((operation = DIVIDE) OR (operation = MODULUS)) AND (float_right_side = 0) then raise Exception.Create('Division by zero : ' + left_side + '/' + right_side);

    case operation of
        POWER : begin Result := FloatToStr(Math.Power(FindFloat(left_side), float_right_side)); end;
        MULTIPLY : begin Result := FloatToStr(FindFloat(left_side) * float_right_side); end;
        DIVIDE : begin Result := FloatToStr(FindFloat(left_side) / float_right_side); end;
        MODULUS : begin Result := FloatToStr(FindInt(left_side) mod FindInt(right_side)); end; // mod requires integer operands
        ADD : begin Result := FloatToStr(FindFloat(left_side) + float_right_side); end;
        SUBTRACT : begin Result := FloatToStr(FindFloat(left_side) - float_right_side); end;
        else raise Exception.Create('Invalid Operation : ' + left_side + char(operation) + right_side);
    end;
end;

function Tcalculate.FindFloat(name : String) : Extended;
var
    value : Extended;
    code : Integer;
    temp_current_pos : Integer;
begin
    // Because FindFloat can be called recursively
    // We need to check if a Finding varible does not have a circular dependency;
    if FUndefined.IndexOf(name) >= 0 then
      Raise Exception.Create('Circular dependency found: '+name);

    FUndefined.Add(name); // We are seeking for it value

    Result := 0.0;
    Val(name, value, code); // valid number?
    if code = 0 then begin
        Result := value;
    end
    else begin // not a number
      if (FMemory <> nil) AND (FMemory.IndexOfName(name) >= 0) then begin
          // hafta temporarily reset the current_pos
          // so that the new calculate call can do
          // its job.
          temp_current_pos := current_pos;

          current_pos := 1;
          Result := StrToFloat(Calculate(RemoveWhiteSpace(FMemory.Values[name])));

          // set it back
          current_pos := temp_current_pos;
      end
      else if Assigned(FOnFindVariable) then TFindVariableEvent(FOnFindVariable)(Self, name, Result)
      else begin
        // Clear FUndefined for future use
        FUndefined.Clear;
        Raise Exception.Create('Variable Undefined : ' + name);
      end;
    end;

    // Good, we find the value for
    FUndefined.Delete(FUndefined.Count-1);
end;

function Tcalculate.FindInt(name : String) : Integer;
begin
    Result := StrToInt(FormatFloat('0', FindFloat(name)));
end;

function Tcalculate.MinPositiveIntValue(numbers : array of integer) : Integer;
var
    i : Integer;
begin
    Result := -1;
    for i := 0 to Length(numbers) -1 do begin
        // operator will not be in the zero position unless it was a
        // negative assertion, in which case it has already been
        // handled before this is used.
        if numbers[i] > 0 then begin
            if Result < 0 then Result := numbers[i]
            else if numbers[i] < Result then Result := numbers[i];
        end;
    end;
end;

function Tcalculate.GetCustom(expression, format : String) : String;
var
    answer : Extended;
begin
    current_pos := 1; // intialize on each request
    answer := FindFloat(Calculate(RemoveWhiteSpace(expression)));

    // add the current answer to the memory
    // so it can be used in the next calculation
    // if needed.
    if FMemory = nil then FMemory := TStringList.Create;
    FMemory.Values['_ANS'] := FloatToStr(answer);

    Result := FormatFloat(format, answer);
end;

function Tcalculate.GetInt(expression : String) : Integer;
begin
    Result := StrToInt(GetCustom(expression, '0'));
end;

function Tcalculate.GetMoney(expression : String) : Extended;
begin
    Result := StrToFloat(GetCustom(expression, '0.00'));
end;

function Tcalculate.GetPercent(expression : String) : String;
begin
    Result := GetCustom(expression, '0.00%');
end;

function Tcalculate.RemoveWhiteSpace(expression : String) : String;
begin
    expression := StringReplace(expression, ' ', '', [rfReplaceAll]); // space
    expression := StringReplace(expression, #10, '', [rfReplaceAll]); // new line
    expression := StringReplace(expression, #13, '', [rfReplaceAll]); // carriage return
    expression := StringReplace(expression, #9, '', [rfReplaceAll]);  // tab
    expression := StringReplace(expression, #12, '', [rfReplaceAll]);  // form feed
    expression := Trim(expression); // anything else on the ends we missed
    Result := expression;
end;

procedure Tcalculate.SetMemory(value : TStringList);
begin
    FMemory.Free;
    FMemory.Assign(value);
end;

function Tcalculate.HandleFunction(name : String) : String;
var
    value : Extended;
begin
    value := 0.0;
    if Assigned(FOnFindFunction) then TFindFunctionEvent(FOnFindFunction)(Self, name, FParams, value)
    else Raise Exception.Create('Function Undefined : ' + name);
    Result := FloatToStr(value);
end;

end.