untformulaedit.pas

简要说明:对医院幼儿心理情况做的一个调查,统计系统.

unit untFormulaEdit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, untBaseDialog, StdCtrls, Buttons, ExtCtrls, jpeg, CalcExpress;

type
  TfrmFormulaEdit = class(TfrmBaseDialog)
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    GroupBox2: TGroupBox;
    btnCheck: TBitBtn;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    cal: TCalcExpress;
    procedure BitBtn1Click(Sender: TObject);
    procedure SpeedButton17Click(Sender: TObject);
    procedure btnCheckClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
    function CheckFormula(var strMsg: string): Boolean;
  public
    { Public declarations }
  end;

function GetFormula(strOld: string = ''): string;

implementation

uses untVarSelect, untGlobalFun;

function GetFormula(strOld: string = ''): string;
begin
  Result := '';
  with TfrmFormulaEdit.Create(Application) do begin
    Memo1.Text := strOld;
    if ShowModal = mrOK then
      Result := Trim(Memo1.Text);
    Free;
  end;
end;

{$R *.dfm}

procedure TfrmFormulaEdit.BitBtn1Click(Sender: TObject);
begin
  inherited;
  Memo1.SetSelTextBuf(PChar(TSpeedButton(Sender).Caption));
end;

procedure TfrmFormulaEdit.SpeedButton17Click(Sender: TObject);
var
  strVar: string;
begin
  inherited;
  strVar := GetVarTag;
  if strVar = '' then Exit;
  Memo1.SetSelTextBuf(PChar(strVar));
end;

procedure TfrmFormulaEdit.btnCheckClick(Sender: TObject);
var
  strMsg: string;
begin
  inherited;
  if CheckFormula(strMsg) then
    MsgOK('公式校验成功！')
  else
    MsgOK('公式校验失败！'+#13+#13+strMsg);
end;

function TfrmFormulaEdit.CheckFormula(var strMsg: string): Boolean;
{var
  iTimes, I: Integer;
  strMemo: string;
  c1,c2: Char;}
begin
  inherited;
  {Result := false;
  strMemo := Memo1.Text;
  if strMemo = '' then begin
    strMsg := '没有任何字符！';
    Exit;
  end;
  c1 := strMemo[1];
  c2 := strMemo[Length(strMemo)];
  if (c1 in ['+','-','*','/']) or (c2 in ['+','-','*','/']) then
  begin
    strMsg := '公式的开始位和结束位不能为运算符号！';
    Exit;
  end;
  iTimes := 0;
  for i:=1 to Length(strMemo) do begin
    if strMemo[i] = '(' then
      Inc(iTimes);
    if strMemo[i] = ')' then
      Dec(iTimes);
    if not (strMemo[i] in []) then begin
      strMsg := '公式中存在除''a..z'',''0..9'',''+'',''-'',''*'',''/'',''('','')'',''.''外的其他非法字符！';
      Exit;
    end;
    if iTimes < 0 then begin
      strMsg := '括号不匹配！';
      Exit;
    end;
  end;
  if iTimes <> 0 then begin
    strMsg := '括号不匹配！';
    Exit;
  end;
  Result := true; }
  try
    cal.Formula := Memo1.Text;
    Result := true;
  except
    Result := false;
  end;
end;

procedure TfrmFormulaEdit.btnOKClick(Sender: TObject);
var
  strMsg: string;
begin
  inherited;
  if CheckFormula(strMsg) then
    ModalResult := mrOk
  else
    MsgOK('公式校验失败！'+#13+#13+strMsg);
end;

end.