calculate.pas

Calculate delphi 7&6

unit Calculate;


//    *******************************************************
//    ***     Created     : 08/02/2002                    ***
//    ***     Last Update : 07/09/2003                    ***
//    ***     Written By  : Mason Liotta                  ***
//    ***     Email       : [e-mail]       ***
//    ***                                                 ***
//    ***    You are free to distribute/change/use this   ***
//    ***  as long as the credits above remain intact.    ***
//    ***  Please notify me of any changes that you make  ***
//    ***  before you redistribute it though. I may want  ***
//    ***  to use the changes too !                       ***
//    ***                                                 ***
//    *******************************************************
//
//    *******************************************************
//    08/09/2002 - Update by Clelson Luiz - Circular Reference Check
//    08/09/2002 - Update by Clelson Luiz - SetMemory procedure
//    07/09/2003 - Update by Mason Liotta - Custom Function Handling!
//    *******************************************************
//
//           To use this Unit simply instantiate an Object
//    ( myObj = Tcalculate.Create ). Then use the public
//    GetXXX methods provided to perform the calculation.
//    Be sure that 'Calculate' is in your uses clause as well.
//    You can also simply add this unit as a component to your
//    palette and then just drop it on your form.
//
//    Example :  myObj.GetCustom('1 - (-2) + 13 * 500 / 8', '0.0');
//    Returns :  '815.5'; ( String Formatted to your specs. )
//
//           Variables can also be used in a couple of ways.
//    I have provided a public TStrings "Memory" list. You must
//    add Strings in the 'name=value' form with no spaces on
//    either side. You may also add a formula ( 'name=formula' ).
//    That will be calculated each time the named variable is
//    requested. A special variable is provided in the memory
//    list that contains the answer for the last calculation.
//    That variable can be used in subsequent calculations by
//    using the name "_ANS" ( without the quotes ).
//
//    Example : myObj.memory.Add('myVariable=2.65');
//              myObj.GetInt('myVariable');
//    Returns : 3; ( Integer )
//
//           You can also handle the OnFindVariableEvent in your
//    code to provide a custom way to search for the variable that
//    is being requested. Simply set the 'value' parameter equal to
//    the value that you want the variable named in the 'name'
//    parameter to hold.
//
//    ****** NEW FEATURE ( as of 07/09/2003 ) *********************
//
//    Custom Function Processing
//    --------------------------------------------------------------------
//
//           Functions inside of your formulas will now be recognized!
//    During processing, if the expression parser comes across an open
//    parentheses where there is no delimiter character directly preeceding it,
//    then it will assume it has entered a function. So an expression
//    like "1 - sin(.5) / 2" will assume that "sin(.5)" is a function
//    call. Since the "n" in "sin" is not a delimiter it assumes any characters
//    before the last delimiter encountered is now the name of the function.
//    In this case, the last delimiter encountered was the "-" so "sin" is
//    now assumed to be the name of the function. All functions are currently
//    customized by you the developer. When a function is found the parser
//    will first build a TStringList of all the parameters ( which can be
//    variables themselves ) and then It will call the OnFindFunctionEvent
//    Handler. Passing in the name of the function, the parameters, and
//    and value variable that you will set. The value variable is used as the
//    return value of the function. If a function is found and the
//    OnFindFunction Event has not been assigned, an Exception will be raised.
//

interface

uses
    Classes, SysUtils, Math;

const
    ADD = ord('+');
    SUBTRACT = ord('-');
    MULTIPLY = ord('*');
    DIVIDE = ord('/');
    MODULUS = ord('%');
    POWER = ord('^');

type TFindVariableEvent = procedure (Sender : TObject; name : String; var value : Extended) of object;
type TFindFunctionEvent = procedure (Sender : TObject; name : String; params : TStrings; var value : Extended) of object;

type
    Tcalculate = class(TComponent)
    private
        { Private Declarations }
        FOnFindVariable : TFindVariableEvent;
        FOnFindFunction : TFindFunctionEvent;
        FMemory : TStringList;
        FUndefined: TStringList;
        FParams : TStrings; // holds the current function parameters
        delimiters : set of char;
        current_pos : Integer; // holds the current read position in the expression
        function doCalc(operation : Integer; left_side, right_side : String) : String;
        function MinPositiveIntValue(numbers : array of integer) : Integer;
        function Calculate(expression : String) : String;
        function RemoveWhiteSpace(expression : String) : String;
        procedure SetMemory(value : TStringList);
    protected
        { Protected Declarations }
        function FindFloat(name : String) : Extended;
        function FindInt(name : String) : Integer;
        function HandleFunction(name : String) : String;
    public
        { Public Declarations }
        constructor Create(aOwner : TComponent); override;
        destructor Destroy; override;

        // All of the GetXXX functions use the GetCustom method
        // for processing. For custom formatting simply pass
        // in a format string that complies with the format
        // strings in the FormatFloat method in Delphi.
        function GetCustom(expression, format : String) : String;
        function GetMoney(expression : String) : Extended;
        function GetInt(expression : String) : Integer;
        function GetPercent(expression : String) : String;
    published
        //     Users will want to add variables to this string list
        // in the form 'name=value' with no spaces. You may also
        // provide a formula like 'name=1+(4/5)-a' if you want.
        //     This particular variable list will have precedence
        // over the OnFindVariable event. In other words, if the
        // variable is found in this string list then the event
        // will not be fired. If, however, the variable is not
        // found in here and the OnFindVariable event is not
        // handled then an Exception will be thrown.
        property memory : TStringList read FMemory write SetMemory;

        //     Users will handle this event to do thier own Variable processing.
        // simply set the 'value' parameter to whatever value you want to
        // give the variable that is named in the 'name' parameter. If this
        // event is not assigned and a variable is encountered that is also
        // not in the "Memory" TStrings ( which has precedence ), an Exception
        // will be thrown.
        //
        // *************************************************************************************************
        // TFindVariableEvent = procedure (Sender : TObject; name : String; var value : Extended) of object;
        // *************************************************************************************************
        //
        property OnFindVariable : TFindVariableEvent read FOnFindVariable write FOnFindVariable;

        //     Users will handle this event to do thier own custom function processing.
        // simply set the 'value' parameter to whatever value you want to
        // give the function that is named in the 'name' parameter. If this
        // event is not assigned and a function is encountered an Exception
        // will be thrown.
        //
        // *************************************************************************************************
        // TFindFunctionEvent = procedure (Sender : TObject; name : String; params : TStrings; var value : Extended) of object;
        // *************************************************************************************************
        //
        property OnFindFunction : TFindFunctionEvent read FOnFindFunction write FOnFindFunction;
    end;

    procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('-ma$on-', [Tcalculate]);
end;

constructor Tcalculate.Create(aOwner : TComponent);
begin
    inherited Create(aOwner);

    // a name=value TStrings list for holding
    // variables throughout the life of the
    // object.
    FMemory := TStringList.Create;

    // To hold undefined variables search, because it is recursive
    FUndefined := TStringList.Create;

    // divide, multiply, modulus, power, add, subtract,
    // open paren, close paren respectively.
    delimiters := ['/', '*', '%', '^', '+', '-', '(', ')', ','];
end;

destructor Tcalculate.Destroy;
begin
    FreeAndNil(FMemory);
    FreeAndNil(FUndefined);
    FreeAndNil(FParams);
    inherited Destroy;
end;

function Tcalculate.Calculate(expression : String) : String;
var
    tokens : TStrings;
    delim_pos : Integer;
begin
    tokens := TStringList.Create;
    tokens.Clear;

    // separate by delimiters
    while ( current_pos <= Length(expression) ) AND
          ( expression[current_pos] <> ')' ) do begin

        tokens.Add('');
        while  ( current_pos <= Length(expression) ) AND (not ( expression[current_pos] in delimiters )) do begin
            tokens[tokens.Count - 1] := tokens[tokens.Count - 1] + expression[current_pos];
            Inc(current_pos);
        end;