main.pas

一个表达式计算库

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, AdCalc, Menus, ExtCtrls, ComCtrls, TeEngine, Series, TeeProcs,
  Chart;

const
  ArgumentVar: string='x';

  Memo2Handle   = 0;
  Memo1Handle   = 1;
  Edit1Handle   = 2;
  Edit2Handle   = 3;
  Edit3Handle   = 4;
  MessageHandle = 5;

type
  TMainForm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label1: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    Panel1: TPanel;
    Label4: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    ListBox1: TListBox;
    Panel2: TPanel;
    Label5: TLabel;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    ListBox2: TListBox;
    Button1: TButton;
    Chart1: TChart;
    Series1: TFastLineSeries;
    Panel3: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    ComboBox1: TComboBox;
    Button10: TButton;
    Edit3: TEdit;
    Label10: TLabel;
    CheckBox1: TCheckBox;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Button11: TButton;
    Button12: TButton;
    ComboBox2: TComboBox;
    Label14: TLabel;
    AdCalc1: TAdCalc;
    Button8: TButton;
    Button9: TButton;
    Button13: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure ListBox2DblClick(Sender: TObject);
    procedure AdCalc1FunctError(Sender: TObject; FunctName: String;
      ErrorLine, ErrorPosition, ErrorPlace, ErrorCode: Integer;
      ErrorStr: String);
    procedure AdCalc1Error(Sender: TObject; ErrorLine, ErrorPosition,
      ErrorPlace, ErrorCode: Integer; ErrorStr: String; Handle: integer);
    procedure Button10Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure AdCalc1GetExtendedVar(Sender: TObject; VarName: String;
      var Found: Boolean; var Value: Extended);
    procedure AdCalc1VarList(Sender: TObject; VarName: String;
      VarType: TExprType; Value: Pointer; Description: String);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure ListBox2Enter(Sender: TObject);
    procedure ListBox1Enter(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure ComboBox2Click(Sender: TObject);
    procedure AdCalc1FunctList(Sender: TObject; FunctName: String;
      FunctType: TExprType; Formula: String; Params: array of TExprType;
      Description: String);
    procedure Button9Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure AdCalc1GetDateTimeVar(Sender: TObject; VarName: String;
      var Found: Boolean; var Value: TDateTime);
    procedure Button13Click(Sender: TObject);
  private
    { Private declarations }
    procedure RefreshVarList;
    procedure RefreshFunctList;
    procedure ApplyFunction;
    function GetVarName:string;
    procedure MakeChart;
    procedure RefreshLib;
    procedure RefreshCombo;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses AddF, AddV;

{$R *.DFM}

procedure TMainForm.RefreshVarList;
var
  i:integer;
begin
  ComboBox1.Items.Clear;
  i:=ListBox2.ItemIndex;
  ListBox2.Items.Clear;
  AdCalc1.GetVarList(false);
  Button10.Enabled := ComboBox1.Text <> '';
  if i>ListBox2.Items.Count-1 then
    ListBox2.ItemIndex:=ListBox2.Items.Count-1
  else ListBox2.ItemIndex:=i;
  ListBox2Click(AdCalc1);
end;

procedure TMainForm.RefreshFunctList;
var
  i:integer;
begin
  i:=ListBox1.ItemIndex;
  ListBox1.Items.Clear;
  AdCalc1.GetFunctList;
  if i>ListBox1.Items.Count-1 then
    ListBox1.ItemIndex:=ListBox1.Items.Count-1
  else ListBox1.ItemIndex:=i;
  ListBox1Click(AdCalc1);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  PageControl1.ActivePage:=TabSheet1;
  ActiveControl:=Memo1;
  RefreshCombo;
end;

procedure TMainForm.ApplyFunction;
var
  FP:array of TExprType;
  i:integer;
begin
  with AddFunct do begin
    if Edit1.Text='' then begin
      ShowMessage('Function name missing');
      Exit;
    end;
    if Memo1.Lines.Count=0 then begin
      ShowMessage('Function expression missing');
      Exit;
    end;
    SetLength(FP,ListBox1.Items.Count);
    with ListBox1 do for i:=0 to Items.Count-1 do begin
      if Items[i]=ComboBox2.Items[0] then FP[i]:=etInteger;
      if Items[i]=ComboBox2.Items[1] then FP[i]:=etExtended;
      if Items[i]=ComboBox2.Items[2] then FP[i]:=etBoolean;
      if Items[i]=ComboBox2.Items[3] then FP[i]:=etString;
      if Items[i]=ComboBox2.Items[4] then FP[i]:=etDateTime;
    end;
    if FP<>nil then begin
      case ComboBox1.ItemIndex of
        {The method declares function, which is determined
        in field "Formula" at run-time}
        0:MainForm.AdCalc1.RegFunction(Edit1.Text, etInteger,
          FP,Memo1.Text,Edit2.Text);
        1:MainForm.AdCalc1.RegFunction(Edit1.Text, etExtended,
          FP,Memo1.Text,Edit2.Text);
        2:MainForm.AdCalc1.RegFunction (Edit1.Text, etBoolean,
          FP,Memo1.Text,Edit2.Text);
        3:MainForm.AdCalc1.RegFunction (Edit1.Text, etString,
          FP,Memo1.Text,Edit2.Text);
        4:MainForm.AdCalc1.RegFunction (Edit1.Text, etDateTime,
          FP,Memo1.Text,Edit2.Text);
      end;
      ClearFields;
    end
    else begin
      ShowMessage('Function parameters missing');
      Exit;
    end;
    RefReshFunctList;
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  with AddFunct do begin
    ClearFields;
    Caption:='Add function';
    Edit1.Enabled:=true;
    ShowModal;
    if ModalResult=mrOk then ApplyFunction;
  end;
end;

procedure TMainForm.Button3Click(Sender: TObject);
var
  FN, Formula, Description:string;
  FT:TExprType;
  i: integer;
begin
  if (ListBox1.ItemIndex>-1)and(ListBox1.Items.Count>0) then begin
    FN:=ListBox1.Items[ListBox1.ItemIndex];
    if AdCalc1.GetFunctProperties(FN,FT,Formula,Description) then
    with AddFunct do begin
      Caption:='Edit function';
      Edit1.Text:=FN;
      Edit1.Enabled:=false;
      Edit2.Text:=Description;
      case FT of
        etInteger  : ComboBox1.ItemIndex:=0;
        etExtended : ComboBox1.ItemIndex:=1;
        etBoolean  : ComboBox1.ItemIndex:=2;
        etString   : ComboBox1.ItemIndex:=3;
        etDateTime : ComboBox1.ItemIndex:=4;
      end;
      Memo1.Text:=Formula;
      ListBox1.Clear;
      for i:=0 to High(AdCalc1.FParams) do
        {Dinamic array Variable "FunctParams" accepts values of
        parameters of the given function. This is used only after
        call of function "GetFunctProperties"}
        case AdCalc1.FParams[i] of
          etInteger  : ListBox1.Items.Add(ComboBox2.Items[0]);
          etExtended : ListBox1.Items.Add(ComboBox2.Items[1]);
          etBoolean  : ListBox1.Items.Add(ComboBox2.Items[2]);
          etString   : ListBox1.Items.Add(ComboBox2.Items[3]);
          etDateTime : ListBox1.Items.Add(ComboBox2.Items[4]);
        end;
      ShowModal;
      if ModalResult=mrOk then ApplyFunction;
    end;
  end;
end;

procedure TMainForm.ListBox1DblClick(Sender: TObject);
begin
  Button3Click(Sender);
end;

procedure TMainForm.Button4Click(Sender: TObject);
var
  i:integer;
begin
  with ListBox1 do if (ItemIndex>-1)and
    (ListBox1.Items.Count>0) then with AdCalc1 do begin
    if MessageDlg('Are you sure to delete function "'+
      UpperCase(ListBox1.Items[ListBox1.ItemIndex])+'"',
      mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      RemoveFunct(Items[ItemIndex]);
      i:=ListBox1.ItemIndex;
      RefReshFunctList;
      RefReshVarList;
      if i>ListBox1.Items.Count-1 then
        ListBox1.ItemIndex:=ListBox1.Items.Count-1
      else ListBox1.ItemIndex:=i;
    end;
  end;
end;

function TMainForm.GetVarName:string;
var
  i:integer;
begin
  Result:='';
  with ListBox2 do if (ItemIndex>-1)and
    (Items.Count>0) then begin
    i:=1;
    while (Items[ItemIndex][i]<>#32)and
          (i<=Length(Items[ItemIndex])) do begin
      Result:=Result+Items[ItemIndex][i];
      inc(i);
    end;
  end;
end;

procedure TMainForm.Button5Click(Sender: TObject);
var
  IV: integer;
  EV: extended;
  BV: boolean;
  SV, Formula: string;
  DV: TDateTime;
begin
  with AddVar do begin
    Caption:='Add variable';
    Label4.Visible:=false;
    Label5.Visible:=false;
    ClearFields;
    Edit1.Enabled:=true;
    ComboBox1.Enabled:=true;
    ActiveControl:=Edit1;
    ShowModal;
    if ModalResult=mrOk then begin
      Formula:=Edit3.Text;
      case ComboBox1.ItemIndex of
        0:begin
          AdCalc1.RegVariable(Edit1.Text,etInteger,Edit2.Text);
          if Edit3.Text<>'' then
            if AdCalc1.GetIntegerResult(Formula,IV,MessageHandle) then
              AdCalc1.SetIntegerVarValue(Edit1.Text,IV);
        end;
        1:begin
          AdCalc1.RegVariable(Edit1.Text,etExtended,Edit2.Text);
          if Edit3.Text<>'' then
            if AdCalc1.GetExtendedResult(Formula,EV,MessageHandle) then
              AdCalc1.SetExtendedVarValue(Edit1.Text,EV);
        end;
        2:begin
          AdCalc1.RegVariable(Edit1.Text,etBoolean,Edit2.Text);
          if Edit3.Text<>'' then
            if AdCalc1.GetBooleanResult(Formula,BV,MessageHandle) then
              AdCalc1.SetBooleanVarValue(Edit1.Text,BV);
        end;
        3:begin
          AdCalc1.RegVariable(Edit1.Text,etString,Edit2.Text);
          if Edit3.Text<>'' then
            if AdCalc1.GetStringResult(Formula,SV,MessageHandle) then
              AdCalc1.SetStringVarValue(Edit1.Text,SV);
        end;
        4:begin
          AdCalc1.RegVariable(Edit1.Text,etDateTime,Edit2.Text);
          if Edit3.Text<>'' then
            if AdCalc1.GetDateTimeResult(Formula,DV,MessageHandle) then
              AdCalc1.SetDateTimeVarValue(Edit1.Text,DV);
        end;
      end;
      RefReshVarList;
    end;
  end;
end;

procedure TMainForm.Button7Click(Sender: TObject);
var
  i:integer;
  VN:string;
begin
  VN:=GetVarName;
  if VN<>'' then with AdCalc1 do begin
    if MessageDlg('Are you sure to delete variable "'+VN+'"',
      mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      RemoveVar(VN);
      i:=ListBox2.ItemIndex;
      RefReshVarList;
      if i>ListBox2.Items.Count-1 then
        ListBox2.ItemIndex:=ListBox2.Items.Count-1
      else ListBox2.ItemIndex:=i;
    end;
  end;
end;

procedure TMainForm.Button6Click(Sender: TObject);
const
  BoolWords: array[Boolean] of string = ('False', 'True');
var
  VN, Description: string;
  VT: TExprType;
  Value: pointer;
  IV: integer;
  EV: extended;