main.pas

一个表达式计算库

  BV: boolean;
  SV, Formula: string;
  DV: TDateTime;
begin
  VN:=GetVarName;
  if VN<>'' then begin
    if AdCalc1.GetVarProperties(VN,VT,Value,Description) then
    with AddVar do begin
      Caption:='Edit variable';
      Label4.Visible:=true;
      Label5.Visible:=true;
      Edit1.Enabled:=false;
      ComboBox1.Enabled:=false;
      Edit1.Text:=VN;
      Edit2.Text:=Description;
      case VT of
        etInteger:begin
          ComboBox1.ItemIndex:=0;
          Label5.Caption:=IntToStr(integer(Value^));
        end;
        etExtended:begin
          ComboBox1.ItemIndex:=1;
          Label5.Caption:=FloatToStr(extended(Value^));
        end;
        etBoolean :begin
          ComboBox1.ItemIndex:=2;
          Label5.Caption:=BoolWords[boolean(Value^)];
        end;
        etString :begin
          ComboBox1.ItemIndex:=3;
          Label5.Caption:='"'+string(Value^)+'"';
        end;
        etDateTime :begin
          ComboBox1.ItemIndex:=4;
          Label5.Caption:=DateTimeToStr(TDateTime(Value^));
        end;
      end;
      ShowModal;
      if (ModalResult=mrOk)and(Edit1.Text<>'') then begin
        Formula:=Edit3.Text;
        case VT of
          etInteger:begin
            AdCalc1.SetVarDescription(VN,Edit2.Text);
            if Edit3.Text<>'' then
              if AdCalc1.GetIntegerResult(Formula,IV,MessageHandle) then begin
                AdCalc1.SetIntegerVarValue(VN,IV);
                ClearFields;
              end;
          end;
          etExtended:begin
            AdCalc1.SetVarDescription(VN,Edit2.Text);
            if Edit3.Text<>'' then
              if AdCalc1.GetExtendedResult(Formula,EV,MessageHandle) then begin
                AdCalc1.SetExtendedVarValue(VN,EV);
                ClearFields;
              end;
          end;
          etBoolean :begin
            AdCalc1.SetVarDescription(VN,Edit2.Text);
            if Edit3.Text<>'' then
              if AdCalc1.GetBooleanResult(Formula,BV,MessageHandle) then begin
                AdCalc1.SetBooleanVarValue(VN,BV);
                ClearFields;
              end;
          end;
          etString :begin
            AdCalc1.SetVarDescription(VN,Edit2.Text);
            if Edit3.Text<>'' then
              if AdCalc1.GetStringResult(Formula,SV,MessageHandle) then begin
                AdCalc1.SetStringVarValue(VN,SV);
                ClearFields;
              end;
          end;
          etDateTime :begin
            AdCalc1.SetVarDescription(VN,Edit2.Text);
            if Edit3.Text<>'' then
              if AdCalc1.GetDateTimeResult(Formula,DV,MessageHandle) then begin
                AdCalc1.SetDateTimeVarValue(VN,DV);
                ClearFields;
              end;
          end;
        end;
        RefReshVarList;
      end;
    end;
  end;
end;

procedure TMainForm.ListBox2DblClick(Sender: TObject);
begin
  Button6Click(Sender);
end;

procedure TMainForm.AdCalc1FunctError(Sender: TObject; FunctName: String;
  ErrorLine, ErrorPosition, ErrorPlace, ErrorCode: Integer;
  ErrorStr: String);
begin
  ShowMessage('Function - "'+UpperCase(FunctName)+
    '"; Line - '+IntToStr(ErrorLine)+
    '; Col - '+IntToStr(ErrorPosition)+'; '+ErrorStr);
end;

procedure TMainForm.AdCalc1Error(Sender: TObject; ErrorLine, ErrorPosition,
  ErrorPlace, ErrorCode: Integer; ErrorStr: String; Handle: integer);
begin
  case Handle of
    Memo2Handle:begin
      ActiveControl:=Memo2;
      Label1.Caption:='Error '+IntToStr(ErrorCode)+', Line '+
        IntToStr(ErrorLine)+', '+ErrorStr;
      Memo2.SelStart:=ErrorPlace;
      Memo2.SelLength:=0;
    end;
    Memo1Handle:begin
      ActiveControl:=Memo1;
      Label1.Caption:='Error '+IntToStr(ErrorCode)+', Line '+
        IntToStr(ErrorLine)+', '+ErrorStr;
      Memo1.SelStart:=ErrorPlace;
      Memo1.SelLength:=0;
    end;
    Edit1Handle:begin
      ActiveControl:=Edit1;
      Label1.Caption:=ErrorStr+'; Col - '+IntToStr(ErrorPlace);
      Edit1.SelStart:=ErrorPosition;
      Edit1.SelLength:=0;
    end;
    Edit2Handle:begin
      ActiveControl:=Edit2;
      Label1.Caption:=ErrorStr+'; Col - '+IntToStr(ErrorPlace);
      Edit2.SelStart:=ErrorPosition;
      Edit2.SelLength:=0;
    end;
    Edit3Handle:begin
      ActiveControl:=Edit3;
      Label1.Caption:=ErrorStr+'; Col - '+IntToStr(ErrorPlace);
      Edit3.SelStart:=ErrorPosition;
      Edit3.SelLength:=0;
    end;
    MessageHandle:begin
      ShowMessage(ErrorStr+'; Col - '+IntToStr(ErrorPosition));
    end;
  end;
end;

procedure TMainForm.MakeChart;
var
  X, FX, MinX, MaxX, DeltaX: extended;
begin
  if AdCalc1.GetBlockResult(Memo2.Text,Memo2Handle) then
    if AdCalc1.ConnectExtendedVar(ArgumentVar,X,pvAdCalc) then begin
      try
        if AdCalc1.GetExtendedResult(Edit1.Text,MinX,Edit1Handle) then
          if AdCalc1.GetExtendedResult(Edit2.Text,MaxX,Edit2Handle) then
            if AdCalc1.GetExtendedResult(Edit3.Text,DeltaX,Edit3Handle) then begin
              X:=MinX;
              Series1.Clear;
              AdCalc1.AddText(Memo1.Text, Memo1Handle);
              while X<=MaxX do begin
                if AdCalc1.ExecuteExtended(FX,Memo1Handle) then begin
                  Series1.Add(FX,FloatToStr(X),clRed);
                  X:=X+DeltaX;
                end
                else Exit;
              end;
              PageControl1.ActivePage:=TabSheet2;
            end;
      finally
        AdCalc1.ClearExpressions;
        if CheckBox1.Checked then
          AdCalc1.DisconnectVar(ArgumentVar,pvAdCalc)
        else AdCalc1.DisconnectVar(ArgumentVar,pvCode);
        RefReshVarList;
      end;
    end;
end;

procedure TMainForm.Button10Click(Sender: TObject);
begin
  Label1.Caption:='';
  MakeChart;
end;

procedure TMainForm.ComboBox1Change(Sender: TObject);
begin
  ArgumentVar:=LowerCase(ComboBox1.Text);
  Button10.Enabled := ComboBox1.Text <> '';
end;

procedure TMainForm.AdCalc1GetExtendedVar(Sender: TObject; VarName: String;
  var Found: Boolean; var Value: Extended);
begin
  if VarName=LowerCase('Argument') then
    Found:=AdCalc1.GetExtendedVarValue(ArgumentVar,Value);
end;

procedure TMainForm.AdCalc1VarList(Sender: TObject; VarName: String;
  VarType: TExprType; Value: Pointer; Description: String);
const
  BoolWords: array[Boolean] of string = ('False', 'True');
var
  vs:string;
begin
  vs:='';
  case VarType of
    etInteger :if Value<>nil then vs:=IntToStr(integer(Value^));
    etExtended:begin
      if Value<>nil then vs:=FloatToStr(extended(Value^));
      ComboBox1.Items.Add(UpperCase(VarName));
      if ArgumentVar=VarName then
        ComboBox1.ItemIndex:=ComboBox1.Items.Count-1;
    end;
    etBoolean  :if Value<>nil then vs:=BoolWords[boolean(Value^)];
    etString   :if Value<>nil then vs:='"'+string(Value^)+'"';
    etDateTime :if Value<>nil then vs:=DateTimeToStr(TDateTime(Value^));
  end;
  ListBox2.Items.Add(UpperCase(VarName)+' = '+vs);
end;

procedure TMainForm.ListBox1Click(Sender: TObject);
var
  s:string;
begin
  with ListBox1 do if (ItemIndex>-1)and(Items.Count>0) then
    if AdCalc1.GetFunctDescription(Items[ItemIndex],s) then
      Label12.Caption:=s;
end;

procedure TMainForm.ListBox2Click(Sender: TObject);
var
  s,VN:string;
begin
  VN:=GetVarName;
  if AdCalc1.GetVarDescription(GetVarName,s) then
    Label12.Caption:=s;
end;

procedure TMainForm.ListBox2Enter(Sender: TObject);
begin
  Listbox1.ItemIndex:=-1;
end;

procedure TMainForm.ListBox1Enter(Sender: TObject);
begin
  Listbox2.ItemIndex:=-1;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  n:extended;
begin
  Label1.Caption:='';
  if AdCalc1.GetBlockResult(Memo2.Text,Memo2Handle) then begin
    if AdCalc1.GetExtendedResult(Memo1.Text,n,Memo1Handle) then begin
      Label1.Caption:='Result = '+FloatToStr(n);
      Memo1.SelectAll;
    end;
    RefReshVarList;
  end;
end;

procedure TMainForm.Button11Click(Sender: TObject);
const
  BoolWords: array[Boolean] of string = ('False', 'True');
var
  b:boolean;
begin
  Label1.Caption:='';
  if AdCalc1.GetBlockResult(Memo2.Text,Memo2Handle) then begin
    if AdCalc1.GetBooleanResult(Memo1.Text,b,Memo1Handle) then begin
      Label1.Caption:='Result = '+BoolWords[b];
      Memo1.SelectAll;
    end;
    RefReshVarList;
  end;
end;

procedure TMainForm.Button12Click(Sender: TObject);
var
  s:string;
begin
  Label1.Caption:='';
  if AdCalc1.GetBlockResult(Memo2.Text,Memo2Handle) then begin
    if AdCalc1.GetStringResult(Memo1.Text,s,Memo1Handle) then begin
      Label1.Caption:='Result = "'+s+'"';
      Memo1.SelectAll;
    end;
    RefReshVarList;
  end;
end;

procedure TMainForm.RefreshLib;
begin
  Label12.Caption:='';
  Memo2.Lines.LoadFromFile(ComboBox2.Text+'.var');
  Memo1.Lines.LoadFromFile(ComboBox2.Text+'.exp');
  AdCalc1.LoadLibrary(ComboBox2.Text+'.lib');
  RefReshVarList;
  RefReshFunctList;
end;

procedure TMainForm.RefreshCombo;
var
  sr: TSearchRec;
  FileAttrs,i: Integer;
  FName,s:string;
begin
  i:=-1;
  s:=ComboBox2.Text;
  ComboBox2.Items.Clear;
  FileAttrs := faAnyFile;
  if FindFirst('*.exp',FileAttrs,sr)=0 then repeat
    FName:=copy(sr.Name,1,Length(sr.Name)-
      Length(ExtractFileExt(sr.Name)));
    ComboBox2.Items.Add(Fname);
    if FName=s then i:=ComboBox2.Items.Count-1;
  until FindNext(sr)<>0;
  FindClose(sr);
  If (ComboBox2.Items.Count>0)and(i=-1) then begin
    ComboBox2.ItemIndex:=0;
    RefreshLib;
  end
  else ComboBox2.ItemIndex:=i;
end;

procedure TMainForm.ComboBox2Click(Sender: TObject);
begin
  RefreshLib;
end;

procedure TMainForm.AdCalc1FunctList(Sender: TObject; FunctName: String;
  FunctType: TExprType; Formula: String; Params: array of TExprType;
  Description: String);
begin
  ListBox1.Items.Add(UpperCase(FunctName));
end;

procedure TMainForm.Button9Click(Sender: TObject);
var
  n:integer;
begin
  Label1.Caption:='';
  if AdCalc1.GetBlockResult(Memo2.Text,Memo2Handle) then begin
    if AdCalc1.GetIntegerResult(Memo1.Text,n,Memo1Handle) then begin
      Label1.Caption:='Result = '+IntToStr(n);
      Memo1.SelectAll;
    end;
    RefReshVarList;
  end;
end;

procedure TMainForm.Button8Click(Sender: TObject);
var
  n:TDateTime;
begin
  Label1.Caption:='';
  if AdCalc1.GetBlockResult(Memo2.Text,Memo2Handle) then begin
    if AdCalc1.GetDateTimeResult(Memo1.Text,n,Memo1Handle) then begin
      Label1.Caption:='Result = ' + DateTimeToStr(n);
      Memo1.SelectAll;
    end;
    RefReshVarList;
  end;
end;

procedure TMainForm.AdCalc1GetDateTimeVar(Sender: TObject; VarName: String;
  var Found: Boolean; var Value: TDateTime);
begin
  if VarName = AnsiLowerCase('Now') then begin
    Found:=true;
    Value:=Now;
  end;
end;

procedure TMainForm.Button13Click(Sender: TObject);
begin
  Memo2.Lines.SaveToFile(ComboBox2.Text+'.var');
  Memo1.Lines.SaveToFile(ComboBox2.Text+'.exp');
  AdCalc1.SaveLibrary(ComboBox2.Text+'.lib');
  RefreshCombo;
end;

end.