calexpression.pas

p2pdbanywhere 可以通过之udp方式远程连接数据库的组件,这个组件非常好,是Delphi7,9,2006能够使用,包含源码.

unit CalExpression;

interface

uses
  SysUtils, Classes,dialogs;

type
  TCalExpression = class(TComponent)
  private
    //变量列表
    FVarLists:Tstrings;
    FExpression:string;
    NumberLB, SignLB: TStrings;
    procedure setexpression(value:string);
    procedure devide(str: string);
    function calculate_expression: double;
    function step(operater: char; x1, x2: double): double;
    { Private declarations }
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddVar(VarName:string);
    procedure SetValue(VarName:string;VarValue:double);
    procedure ClearVar;
    procedure DeleteVar(VarName:string);
    function GetValue(VarName:string):double;
    function Calculate:double;
    property VarLists:Tstrings read FVarLists;
    { Public declarations }
  published    
    property Expression:string read FExpression write setexpression;
    { Published declarations }
  end;

const
  operators = ['+', '-', '*', '/', '(', ')'];
procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DbAnyWhere', [TCalExpression]);
end;
constructor TCalExpression.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  NumberLB := TStringList.Create;
  SignLB := TStringList.Create;
  FVarLists:=Tstringlist.Create;
end;
destructor TCalExpression.Destroy;
begin
  inherited Destroy;
  Freeandnil(NumberLB);
  freeandnil(SignLB);
  freeandnil(FVarLists);
end;
procedure TCalExpression.setexpression(value:string);
var
  i,j:integer;
begin
  FExpression:=value;
  //分析公式
  if length(trim(FExpression))>0 then
  begin
    devide(Fexpression);
    //自动提取变量(分析numberlb)
    for i:=0 to numberlb.Count-1 do
    begin
      for j:=1 to length(numberlb.Strings[i]) do
      begin
        if not(numberlb.Strings[i][j] in['0'..'9','.','-']) then
        begin
          if fvarlists.IndexOfName(numberlb.Strings[i])=-1 then
          begin
            fvarlists.Add(numberlb.Strings[i]+'=');
            break;
          end;
        end;
      end;
    end;
  end;
  //showmessage(fvarlists.Text);
end;
procedure TCalExpression.ClearVar;
begin
  FVarLists.Clear;
end;
procedure TCalExpression.DeleteVar(VarName:string);
begin
  if Fvarlists.IndexOfName(varname)>-1 then
     fvarlists.Delete(Fvarlists.IndexOfName(varname))
  else
    showmessage('不存在['+VarName+']变量！');
end;
function TCalExpression.GetValue(VarName:string):double;
begin
  if Fvarlists.IndexOfName(varname)>-1 then
  begin
     result:=strtofloat(fvarlists.Values[VarName]);
  end else
  begin
    showmessage('不存在['+VarName+']变量！');
    result:=0;
  end;
end;
procedure TCalExpression.AddVar(VarName:string);
begin
  if Fvarlists.IndexOfName(varname)>-1 then
  begin
    showmessage('已经存在['+VarName+']变量！');
    exit;
  end;
  FVarLists.Add(VarName+'=');
end;
procedure TCalExpression.SetValue(VarName:string;VarValue:double);
begin
  if Fvarlists.IndexOfName(varname)=-1 then
  begin
    showmessage('不存在['+VarName+']变量！');
    exit;
  end;
  Fvarlists.Values[varname]:=floattostr(varvalue);
end;
function TCalExpression.Calculate:double;
var
  i:integer;
begin
  if length(trim(Fexpression))=0 then
  begin
    showmessage('请指定计算公式！');
    abort;
  end;
  //判断所有变量是否都有值
  for i:=0 to Fvarlists.Count-1 do
  begin
    if length(trim(fvarlists.ValueFromIndex[i]))=0 then
    begin
      if numberlb.IndexOf(fvarlists.Names[i])=-1 then
      begin
        showmessage('['+fvarlists.Names[i]+']没有赋值！');
        result:=0;
        exit;
      end;
    end;
  end;
  //对值列表进行替换
  for i:=0 to numberlb.Count-1 do
  begin
    if fvarlists.IndexOfName(numberlb.Strings[i])=-1 then
    begin
      try
        strtofloat(numberlb.Strings[i]);
      except
        showmessage('不存在变量['+numberlb.Strings[i]+']');
        exit;
      end;
    end else
    numberlb.Strings[i]:=fvarlists.Values[numberlb.Strings[i]];
  end;  
  result := calculate_expression;
end;
procedure TCalExpression.devide(str: string);
var
  i: integer;
  number: string;
begin
  numberlb.Clear;
  signlb.Clear;
  number := '';
  for i := 1 to length(str) do
  begin
    if (str[i] in operators) then
    begin
      signlb.Add(str[i]);
      if number <> '' then
      begin
        numberlb.Add(number);
        number := '';
      end;
    end
    else if str[i] = ' ' then
    //
    else
      number := number + str[i];
  end;
  if number <> '' then
  begin
    numberlb.Add(number);
    number := '';
  end;
  {showmessage(numberlb.Text);
  showmessage(signlb.Text);  }
end;

function TCalExpression.calculate_expression: double;
var
  sign, nextsign: string;
  x1, x2: double;
begin  
  if SignLB.Count > 0 then
  begin
    sign := SignLB[0];
    SignLB.Delete(0);
    if SignLB.Count > 0 then
      nextsign := SignLB[0]
    else
      nextsign := ' ';
    case sign[1] of
      '+', '-':
        begin
          x1 := strtofloat(NumberLB[0]);
          numberlb.Delete(0);
          case nextsign[1] of
            '+', '-', ' ', ')':
              begin
                x2 := strtofloat(numberlb[0]);
                numberlb.Delete(0);
                numberlb.Insert(0, floattostr(step(sign[1], x1, x2)));
                result := calculate_expression;
              end;
            '*', '/':
              result := step(sign[1], x1, calculate_expression);
            '(':
              begin
                signlb.Delete(0);
                x2 := calculate_expression;
                NumberLB.Insert(0, floattostr(step(sign[1], x1, x2)));
                result := calculate_expression;
              end;
          end;
        end;
      '*', '/':
        begin
          x1 := strtofloat(numberlb[0]);
          numberlb.Delete(0);
          case nextsign[1] of
            '+', '-', '*', '/', ')', ' ':
              begin
                x2 := strtofloat(NumberLB[0]);
                numberlb.Delete(0);
              end;
            '(':
              begin
                signlb.Delete(0);
                x2 := calculate_expression;
              end;
          end;
          numberlb.Insert(0, floattostr(step(sign[1], x1, x2)));
          result := calculate_expression;
        end;
      '(':
        begin
          x2 := calculate_expression;
          numberlb.Insert(0, floattostr(x2));
          result := calculate_expression;
        end;
      ')':
        begin
          x2 := strtofloat(numberlb[0]);
          numberlb.Delete(0);
          result := x2;
        end;
    end;
  end
  else
  begin
    x1 := strtofloat(numberlb[0]);
    numberlb.Delete(0);
    result := x1;
  end;
end;
function TCalExpression.step(operater: char; x1, x2: double): double;
begin
  case operater of
    '+': result := x1 + x2;
    '-': result := x1 - x2;
    '*': result := x1 * x2;
    '/':
      begin
        if x2 = 0 then
          result := 0
        else
          result := x1 / x2;
      end;
  end;
end;
end.