THFormula Integration Example

unit Parser;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     StdCtrls, Parser8, Buttons, DBTables, DB, Grids, DBGrids,
     ExtCtrls, THFormula, DBCtrls;

Type
  TForm1 = class(TForm)
    Formula1:     TTHFormula;
    DataSource1:  TDataSource;
    DBNavigator1: TDBNavigator;
    DBGrid1: TDBGrid;
    Table1:  TTable;
    Table1PartNo:      TFloatField;    Table1VendorNo: TFloatField;
    Table1Description: TStringField;   Table1OnHand:   TFloatField;
    Table1OnOrder:     TFloatField;    Table1Cost:     TCurrencyField;
    Table1ListPrice:   TCurrencyField;
    sbEval: TSpeedButton;
    eResult: TEdit;    eErrors: TEdit;    eResultType: TEdit;   eEntry: TComboBox;
    Panel1:  TPanel;   Panel2: TPanel;
    Label1:  TLabel;
    Label2:  TLabel;   Label3: TLabel;    Label4: TLabel;    Label5: TLabel;
    Label6:  TLabel;   Label7: TLabel;    Label8: TLabel;    Label9: TLabel;
    Label10: TLabel;   Label11: TLabel;   Label12: TLabel;   Label13: TLabel;
    Label14: TLabel;   Label15: TLabel;   Label16: TLabel;   Label17: TLabel;
    Label18: TLabel;   Label19: TLabel;   Label20: TLabel;   Label21: TLabel;
    GroupBox1: TGroupBox;    GroupBox2: TGroupBox;    GroupBox3: TGroupBox;

    procedure sbEvalClick    (Sender: TObject);
    procedure eEntryKeyPress (Sender: TObject; var Key: Char);
    procedure Formula1Error  (Sender: TObject);
    procedure FormCreate     (Sender: TObject);
    procedure Formula1Change (Sender: TObject);
    procedure Formula1Zero   (Sender: TObject);
    procedure Formula1Plus   (Sender: TObject);
    procedure Formula1Minus  (Sender: TObject);
    procedure Formula1True   (Sender: TObject);
    procedure Formula1False  (Sender: TObject);
    procedure Formula1String (Sender: TObject);
    procedure Formula1Boolean(Sender: TObject);
    procedure Formula1Integer(Sender: TObject);
    procedure Formula1Float  (Sender: TObject);
    procedure FormShow       (Sender: TObject);

  private
  public
  end;

var Form1: TForm1;

implementation

{$R *.DFM}

//-----------------------------------------------------------------------------
const YN:array[boolean] of string=('No ','Yes');

// Define a new function returning a TOperand and 
// using as an argument array a TStringList
function YesNo(Args: TStringList):TOperand;
begin
  if Args.Count<>1 then 
    raise SyntaxError.Create('Yes/No takes only one argument');
  result:=TOperand.CreateStr(YN[TOperand(Args.Objects[0]).AsBoolean]);
  TOperand(Args.Objects[0]).Free;
end;

//-----------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Embbed the above function in THFormula with a name to use in expressions
  Formula1.AddFunction('YesNo',@YesNo);
  // Add a new symbol - Profit in the Symbol Table combining
  // two fields existing in the data source
  Formula1.SymbolTable.Add('Profit=[ListPrice]-[Cost]');
end;


// Rest of the code links the THFormula component in the form from the
// previous page

procedure TForm1.eEntryKeyPress(Sender: TObject; var Key: Char);
begin 
  if Key=^m then sbEvalClick(Sender);
end;

procedure TForm1.sbEvalClick(Sender: TObject);
begin
  sbEval.Enabled:=false;
  Application.ProcessMessages;
  Formula1.Formula:=eEntry.Text;
end;

procedure TForm1.Formula1Error(Sender: TObject);
begin
  eErrors.Color:=clRed;
  eErrors.Text:=Formula1.ErrorMsg;
  sbEval.Enabled:=true;
end;

procedure TForm1.Formula1Change(Sender: TObject);
begin
  eErrors.Color:=clNavy;
  eErrors.Text:='';
  eResult.text:=Formula1.AsString;
  sbEval.Enabled:=true;
end;

procedure TForm1.Formula1Zero(Sender: TObject);
begin 
  eResult.Font.Color:=clBlack;
end;

procedure TForm1.Formula1Plus(Sender: TObject);
begin 
  eResult.Font.Color:=clGreen;
end;

procedure TForm1.Formula1Minus(Sender: TObject);
begin 
  eResult.Font.Color:=clRed;
end;

procedure TForm1.Formula1True(Sender: TObject);
begin 
  eResult.Font.Color:=clNavy;
end;

procedure TForm1.Formula1False(Sender: TObject);
begin 
  eResult.Font.Color:=clOlive;
end;

procedure TForm1.Formula1String(Sender: TObject);
begin
  eResultType.Text:='S';
  eResult.Font.Color:=clBlack;
end;

procedure TForm1.Formula1Boolean(Sender: TObject);
begin 
  eResultType.Text:='B';
end;

procedure TForm1.Formula1Integer(Sender: TObject);
begin 
  eResultType.Text:='I';
end;

procedure TForm1.Formula1Float(Sender: TObject);
begin 
  eResultType.Text:='F';
end;

procedure TForm1.FormShow(Sender: TObject);
begin 
  Formula1Change(Sender);
end;

end.