unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,CioinaEval, StdCtrls, Buttons,math;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Memo1: TMemo;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    CheckBox1: TCheckBox;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure ParseErrorMesssage(Sender: TObject);
    procedure ExecuteErrorMesssage(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Edit1Click(Sender: TObject);
    procedure Edit2Click(Sender: TObject);
    procedure Edit3Click(Sender: TObject);
    procedure Memo2Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  P1,P2 : PTreal;
  ev,ev1: TCioinaEval;
  a     : TUserVarArray;
implementation

{$R *.dfm}
{---------------------------------------------------------}
function MyE(Pv:PVectorPTReal;PvCount:Integer):TReal;
begin
 Result:=Exp(1);
end;
{---------------------------------------------------------}
function MySum(Pv:PVectorPTReal;PvCount:Integer):TReal;
var i:Integer;
begin
 Result:=0;
 for i:=1 to PvCount do Result:=Result+Pv^[i]^;
end;
{---------------------------------------------------------}
function MySqrt(Pv:PVectorPTReal;PvCount:Integer):TReal;
begin
 Result:=Sqrt(Pv^[1]^);
end;
{---------------------------------------------------------}
function MyRandom(Pv:PVectorPTReal;PvCount:Integer):TReal;
begin
 Result:=Random;
end;
{---------------------------------------------------------}
procedure TForm1.ExecuteErrorMesssage(Sender: TObject);
var s,s1:string;
    i   :Integer;
begin
 with Sender as TCioinaEval do
 begin
  i:=Pos(':',ErrorMessageInfo);
  if i>0 then  s1:=' : '+Copy(ErrorMessageInfo,i+1,Length(ErrorMessageInfo)-i) else s1:='';
  if Length(s1)>256 then s1:=Copy(s1,1,256);
  s1:=LowerCase(s1);

  s:='';
  case MathException of
   EX_NONMATH:s:=' : NONMATH';
   EX_Overflow:s:=' : Overflow';
   EX_Underflow:s:=' : Underflow';
   EX_InvalidArgument:s:=' : InvalidArgument';
   EX_ZeroDivide:s:=' : ZeroDivide';
   EX_InvalidOp:s:=' : InvalidOp';
  end;

  case ErrorNumber of
   ERR_NO_MATH_EXPRESSION_WAS_PARSED:           Memo1.Text:=('No math expression was parsed');
   ERR_VARIABLES_AND_VALUES_ARE_DIFFERENT:      Memo1.Text:=('Variable count and value caunt do not corespond');
   ERR_MATH_EXPRESSIONS_ARRAY:                  Memo1.Text:=('Use ''DoVectorOfMathExpressions'' for calculate a vector of math expression');
   ERR_EXECUTE:                                 Memo1.Text:=('Execution error');
   ERR_DEF_FUNCTION_STACK_OVERFLOW:             Memo1.Text:=('Stack overflow'+s1);
   ERR_SYSTEM_STACK_OVERFLOW:                   Memo1.Text:=('Fatal error'+s1);
   ERR_MULTIPLY:                                Memo1.Text:=('Invalid value for *'+s1+s);
   ERR_DIVISION:                                if MathException=EX_ZeroDivide
                                                then Memo1.Text:=('Division by 0 ')
                                                else Memo1.Text:=('Invalid value for /'+s1+s);
   ERR_PLUS:                                    Memo1.Text:=('Invalid value for +'+s1+s);
   ERR_MINUS:                                   Memo1.Text:=('Invalid value for -'+s1+s);
   ERR_POWER:                                   Memo1.Text:=('Invalid value for ^'+s1+s);
   ERR_EQUAL:                                   Memo1.Text:=('Invalid value for ='+s1+s);
   1..FunCount:
               if s=''
               then Memo1.Text:=('Invalid number of function arguments for: '+ UpperCase(aStr[ErrorNumber]))
               else Memo1.Text:=('Invalid value for '+ UpperCase(aStr[ErrorNumber])+s1+s);
   else if ErrorNumber>FunCount
        then
         if s=''
         then  Memo1.Text:=('Invalid number of function arguments for: '+UpperCase(UserFunctionName[ErrorNumber-FunCount-1]))
         else  Memo1.Text:=('Invalid value for '+ UpperCase(UserFunctionName[ErrorNumber-FunCount-1])+s1+s)
        else Memo1.Text:=(ErrorMessageInfo);
  end;
 end;
end;

procedure TForm1.ParseErrorMesssage(Sender: TObject);
var s,s1:string;
    i:Integer;
begin
 with Sender as TCioinaEval do
 begin
  i:=Pos(':',ErrorMessageInfo);
  if i>0 then  s1:=' : '+Copy(ErrorMessageInfo,i+1,Length(ErrorMessageInfo)-i) else s1:='';
  if Length(s1)>256 then s1:=Copy(s1,1,256);
  s1:=LowerCase(s1);
  s:='';
  case MathException of
   EX_NONMATH:s:=' : NONMATH';
   EX_Overflow:s:=' : Overflow';
   EX_Underflow:s:=' : Underflow';
   EX_InvalidArgument:s:=' : InvalidArgument';
   EX_ZeroDivide:s:=' : ZeroDivide';
   EX_InvalidOp:s:=' : InvalidOp';
  end;

  case ErrorNumber of
   ERR_PARSE:                                   Memo1.Text:=('Invalid expression'+s1);
   ERR_BAD_SYNTAX:                              Memo1.Text:=('Syntax error'+s1);
   ERR_COMMA_SYNTAX:                            Memo1.Text:=('Comma syntax error'+s1);
   ERR_NO_MATH_EXPRESSION_WAS_PARSED:           Memo1.Text:=('No math expression was parsed');
   ERR_PARANTHESES_SYNTAX_ERROR:                Memo1.Text:=('Mismatched parenthesis');
   ERR_INVALID_DERIVATIVE_VARIABLE_NAME:        Memo1.Text:=('Invalid name of derivative variable'+s1);
   ERR_MATH_EXPRESSION_IS_EMPTY:                Memo1.Text:=('Mathematical expression is empty');
   ERR_IDENTIFIER_CANNOT_BE_EMPTY:              Memo1.Text:=('Identifier cannot be empty');
   ERR_IDENTIFIER_LENGTH:                       Memo1.Text:=('Identifier length is too long'+s1);
   ERR_NOT_PASCAL_IDENTIFIER:                   Memo1.Text:=('Invalid identifier'+s1);
   ERR_IDENTIFIER_CANNOT_BE_RESERVED_NAME:      Memo1.Text:=('Identifier cannot be a reserved name'+s1);
   ERR_IDENTIFIER_ALREADY_EXISTS:               Memo1.Text:=('Identifier already exists'+s1);
   ERR_DUBLICATING_USER_IDENTIFIER:             Memo1.Text:=('Dublicating user identifier'+s1);
   ERR_UNKNOWN_EXPRESSION:                      Memo1.Text:=('Unknown expression'+s1);
   ERR_UNKNOWN_FUNCTION:                        Memo1.Text:=('Undefined function'+s1);
   ERR_UNKNOWN_VARIABLE:                        Memo1.Text:=('Undefined variable'+s1);
   ERR_BAD_EXPONENTIAL_FORMAT:                  Memo1.Text:=('Invalid exponent value'+s1);
   ERR_SET_OriginalMathExpressionString_FALSE:  Memo1.Text:=('Set ''OriginalMathExpressionString'' to FALSE for differentiation or for Mathematica 4.1 export');
   ERR_MATH_EXPRESSION_WAS_ERASED:              Memo1.Text:=('Mathematical expression string was erased');
   ERR_USE_VerifySyntaxSemanticsAndDerivation:  Memo1.Text:=('Use ''VerifySyntaxSemanticsAndDerivation'' for differentiation');
   ERR_DERIVATIVE_EXPRESSION_WAS_ERASED:        Memo1.Text:=('Derivative expression string was erased');
   ERR_VARIABLES_AND_VALUES_ARE_DIFFERENT:      Memo1.Text:=('Variable count and value caunt do not corespond');
   ERR_MATH_EXPRESSIONS_ARRAY:                  Memo1.Text:=('Use ''DoVectorOfMathExpressions'' for calculate a vector of math expression');
   ERR_FUNCTION_NUMBER_MUST_BE_LESS:            Memo1.Text:=('Function number must be less'+s1);
   ERR_FUNCTION_ADDRESS_CANNOT_BE_NIL:          Memo1.Text:=('Function address cannot be nil'+s1);
   ERR_PROTECTED_EXPRESSION:                    Memo1.Text:=('Cannot set value for protected expression'+s1);
   ERR_DEF_FUNC_NAME:                           Memo1.Text:=('Invalid function name'+s1);
   ERR_DEF_FUNC_DUBLICATING:                    Memo1.Text:=('Dublicating defined function'+s1);
   ERR_DEF_FUNC_IMPLEMENTING:                   Memo1.Text:=('Defined function was not implimented'+s1);
   ERR_DEF_FUNC_ARG_COUNT:                      Memo1.Text:=('Invalid arguments number for defined function'+s1);
   ERR_DEF_FUNC_ARG_NAME:                       Memo1.Text:=('Invalid argument name for defined function'+s1);
   ERR_DEF_FUNC_ARG_DUBLICATING:                Memo1.Text:=('Dublicating argument name for defined function'+s1);
   ERR_MULTIPLY:                                Memo1.Text:=('Invalid value for *'+s1+s);
   ERR_DIVISION:                                if MathException=EX_ZeroDivide
                                                then Memo1.Text:=('Division by 0')
                                                else Memo1.Text:=('Invalid value for /'+s1+s);
   ERR_PLUS:                                    Memo1.Text:=('Invalid value for +'+s1+s);
   ERR_MINUS:                                   Memo1.Text:=('Invalid value for -'+s1+s);
   ERR_POWER:                                   Memo1.Text:=('Invalid value for ^'+s1+s);
   ERR_EQUAL:                                   Memo1.Text:=('Invalid value for ='+s1+s);
   1..FunCount:
               if s=''
               then Memo1.Text:=('Invalid number of function arguments for: '+ UpperCase(aStr[ErrorNumber]))
               else Memo1.Text:=('Invalid value for '+ UpperCase(aStr[ErrorNumber])+s1+s);
   else if ErrorNumber>FunCount
        then
         if s=''
         then  Memo1.Text:=('Invalid number of function arguments for: '+UpperCase(UserFunctionName[ErrorNumber-FunCount-1]))
         else  Memo1.Text:=('Invalid value for '+ UpperCase(UserFunctionName[ErrorNumber-FunCount-1])+s1+s)
        else Memo1.Text:=(ErrorMessageInfo);
  end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var v:TUserFuncArray;
begin
 DecimalSeparator:='.';
 SetLength(v,4);
 v[0].VarCount:=0;
 v[0].FuncName:='MyE';
 v[0].FuncAddress:=MyE;
 v[1].VarCount:=MaxFuncParam;
 v[1].FuncName:='MySum';
 v[1].FuncAddress:=MySum;
 v[2].VarCount:=1;
 v[2].FuncName:='MySqrt';
 v[2].FuncAddress:=MySqrt;
 v[3].VarCount:=-1;
 v[3].FuncName:='MyRandom';
 v[3].FuncAddress:=MyRandom;
 New(P1);
 New(P2);
 SetLength(a,2);
 a[0].StrExpr:='x';  a[0].Value:=P1;
 a[1].StrExpr:='y';  a[1].Value:=P2;
 ev:=TcioinaEval.Create(v);
 ev1:=TcioinaEval.Create(v);
 SetLength(v,0);
 ev.OnVerifySyntaxSemanticsError:=ParseErrorMesssage;
 ev.OnDoMathExpressionError:=ExecuteErrorMesssage;
 ev1.OnVerifySyntaxSemanticsError:=ParseErrorMesssage;
 ev1.OnDoMathExpressionError:=ExecuteErrorMesssage;
 Caption:=ev.VersionInfo+'    '+ev.OwnerInfo;
 Edit1Change(Self);
 Edit2Change(Self);
 Memo2Change(Self);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 Dispose(P1);
 Dispose(P2);
 ev.Free;
 ev1.Free;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Memo1.Text:='';
  ev1.VerifySyntaxSemantics(Edit1.Text);
  if ev1.ErrorFlag
  then
  begin
   P1^:=nan;
   Label5.Caption:=FloatToStr(P1^);
   Label1.Caption:='Result';
  end
  else
  begin
   P1^:=ev1.DoMathExpression;
   Label5.Caption:=FloatToStr(P1^);
   Label1.Caption:='Result = '+FloatTostr(ev.DoMathExpression);
  end;
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  Memo1.Text:='';
  ev1.VerifySyntaxSemantics(Edit2.Text);
  if ev1.ErrorFlag
  then
  begin
   P2^:=nan;
   Label6.Caption:=FloatToStr(P2^);
   Label1.Caption:='Result';
  end
  else
  begin
   P2^:=ev1.DoMathExpression;
   Label6.Caption:=FloatToStr(P2^);
   Label1.Caption:='Result = '+FloatTostr(ev.DoMathExpression);
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
 if CheckBox1.Checked
 then
 begin
  CheckBox1.Caption:='Space like multiply operator (true)';
  ev.SpaceLikeMultiply:=true;
  ev1.SpaceLikeMultiply:=true;
  Edit1Change(Self);
  Edit2Change(Self);
  Memo2Change(Self);
 end
 else
 begin
  CheckBox1.Caption:='Space like multiply operator (false)';
  ev.SpaceLikeMultiply:=false;
  ev1.SpaceLikeMultiply:=false;
  Edit1Change(Self);
  Edit2Change(Self);
  Memo2Change(Self);
 end;
end;

procedure TForm1.Edit1Click(Sender: TObject);
begin
 Edit1Change(Self);
end;

procedure TForm1.Edit2Click(Sender: TObject);
begin
 Edit2Change(Self);
end;

procedure TForm1.Edit3Click(Sender: TObject);
begin
 Memo2Change(Self);
end;

procedure TForm1.Memo2Change(Sender: TObject);
 var s:string;
begin
 Label7.Caption:='Math Expression :';
 Label1.Caption:='Result';
 Memo1.Clear;
 s:=StringReplace(Trim(Memo2.Text),''#$D#$A'','',[rfReplaceAll]);
 ev.VerifySyntaxSemantics(s,a,false);
 if not(ev.ErrorFlag)
 then
 begin
  Label7.Caption:='Math Expression : OK';
  Label1.Caption:='Result = '+FloatTostr(ev.DoMathExpression);
 end;
end;

end.
