hwformula.pas.svn-base

一个用Delphi开发的ERP软件

unit HwFormula;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, atScript, DB, ADODB, StrUtils,
  ActnList, atPascal, ComCtrls;

type
  THwFormulaForm = class(TForm)
    gbCondition: TGroupBox;
    gbOperation: TGroupBox;
    gbFunction: TGroupBox;
    sbIf: TSpeedButton;
    sbThen: TSpeedButton;
    sbElse: TSpeedButton;
    lbFunction: TListBox;
    sbOr: TSpeedButton;
    sbAnd: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    sbDiv: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    Bevel1: TBevel;
    bbtnOk: TBitBtn;
    bbtnExit: TBitBtn;
    bbtnCheck: TBitBtn;
    Scripter: TatPascalScripter;
    cbLang: TCheckBox;
    gbItem: TGroupBox;
    lbItem: TListBox;
    ActionList1: TActionList;
    ActUndo: TAction;
    RichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure bbtnOkClick(Sender: TObject);
    procedure bbtnExitClick(Sender: TObject);
    procedure bbtnCheckClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ScripterCompileError(Sender: TObject; var msg: String; row,
      col: Integer; var ShowException: Boolean);
    procedure lbItemDblClick(Sender: TObject);
    procedure lbFunctionDblClick(Sender: TObject);
    procedure ActUndoExecute(Sender: TObject);
    procedure sbIfClick(Sender: TObject);
    procedure sbThenClick(Sender: TObject);
    procedure sbElseClick(Sender: TObject);
    procedure sbOrClick(Sender: TObject);
    procedure sbAndClick(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure sbDivClick(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure SpeedButton14Click(Sender: TObject);
    procedure SpeedButton15Click(Sender: TObject);
    procedure SpeedButton16Click(Sender: TObject);
    procedure SpeedButton17Click(Sender: TObject);
    procedure RichEdit1Change(Sender: TObject);
  private
    procedure SetInterface;
    { Private declarations }
  public
    AMode:string;
    AType:string;
    AItemNo:Integer;
    AItemID:string;
    AItemNm:String;
    { Public declarations }
  end;

var
  HwFormulaForm: THwFormulaForm;

implementation

uses CommFun, SYSDATA;

{$R *.dfm}

procedure THwFormulaForm.SetInterface;
begin
  Font.Name:=AFontName;
  Caption:=GetDBString('FUN10001001');  //自定义公式
  bbtnCheck.Caption:=GetDBString('FUN10001002');  //语法检查(&C)
  bbtnOk.Caption:=GetDBString('FUN10001003');  //确定(&O)
  bbtnExit.Caption:=GetDBString('FUN10001004');  //退出(&X)
  cbLang.Caption:=GetDBString('FUN10001005');  //使用程序语言
  gbFunction.Caption:=GetDBString('FUN10001006');  //函数
  gbCondition.Caption:=GetDBString('FUN10001007');  //条件
  gbOperation.Caption:=GetDBString('FUN10001008');  //运算符
  gbItem.Caption:=GetDBString('FUN10001009');  //项目
end;

procedure THwFormulaForm.FormCreate(Sender: TObject);
begin
  SetInterface;
end;

procedure THwFormulaForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
//
end;

//解析公式，即将公式中所有的函数转换成数值
function ParseFunction(AFormulaString,AItemID:string;AItemNo:Integer):string;
var
  S,R,ASubStr:String;
  AStart,AEnd,I:Integer;
begin
  S:=AFormulaString;
  R:=S;
  //取得函数的值并替换
  AStart:=0;
  AEnd:=0;
  for I:=1 to Length(S) do
  begin
    if (AStart=0) and (S[I]='[') then AStart:=I
    else if (AEnd=0) and (S[I]=']') then AEnd:=I;
    if (AStart<>0) and (AEnd<>0) then
    begin
      ASubStr:=Copy(S,AStart,AEnd-AStart+1);
      ReplaceString(ASubStr,'0',R);
      AStart:=0;
      AEnd:=0;
    end;
  end;
  S:=R;
  //取得考勤项目的值并替换
  AStart:=0;
  AEnd:=0;
  for I:=1 to Length(S) do
  begin
    if (AStart=0) and (S[I]='@') then AStart:=I
    else if (AEnd=0) and (S[I]='@') then AEnd:=I;
    if (AStart<>0) and (AEnd<>0) then
    begin
      ASubStr:=Copy(S,AStart,AEnd-AStart+1);
      ReplaceString(ASubStr,'0',R);
      AStart:=0;
      AEnd:=0;
    end;
  end;
  S:=R;
  //取得薪资项目的值并替换
  AStart:=0;
  AEnd:=0;
  for I:=1 to Length(S) do
  begin
    if (AStart=0) and (S[I]='%') then AStart:=I
    else if (AEnd=0) and (S[I]='%') then AEnd:=I;
    if (AStart<>0) and (AEnd<>0) then
    begin
      ASubStr:=Copy(S,AStart,AEnd-AStart+1);
      ReplaceString(ASubStr,'0',R);
      AStart:=0;
      AEnd:=0;
    end;
  end;
  S:=R;

  //将项目名称替换成Result
  while Pos('#'+AItemID+'#',S)<>0 do ReplaceString('#'+AItemID+'#','Result',S);
  Result:=S;
end;

procedure THwFormulaForm.bbtnOkClick(Sender: TObject);
var
  S:String;
begin
//确定(&O)
  S:=SetFunct(RichEdit1.Text,AItemID,AItemNm,AType);
  Scripter.SourceCode.Clear;
  Scripter.SourceCode.Add(ParseFunction(S,AItemID,AItemNo));
  Scripter.Compile;
  RichEdit1.Text:=S;
  ModalResult:=1;
end;

procedure THwFormulaForm.bbtnExitClick(Sender: TObject);
begin
//退出(&X)
  Close;
end;

procedure THwFormulaForm.bbtnCheckClick(Sender: TObject);
var
  S:string;
begin
//语法检查(&C)
  if trim(RichEdit1.Text)='' then
  begin
    ShowMsg('UMS10000224');  //自定义公式设置不能为空
    RichEdit1.SetFocus;
    Abort;
  end;
  S:=SetFunct(RichEdit1.Text,AItemID,AItemNm,AType);
  S:=ParseFunction(S,AItemID,AItemNo);
  Scripter.SourceCode.Clear;
  Scripter.SourceCode.Add(S);
  Scripter.Compile;
  ShowMsg('UMS10000247');  //自定义公式语法检查成功
end;

procedure THwFormulaForm.FormShow(Sender: TObject);
begin
  //取得所有项目
  lbItem.Clear;
  SYSDM.qryQuery.Close;
  SYSDM.qryQuery.SQL.Clear;
  if AType='CWA' then
    SYSDM.qryQuery.SQL.Add('select C150_003 from CWA150 where C150_001<>'+IntToStr(AItemNo))
  else if AType='PAY' then
    SYSDM.qryQuery.SQL.Add('select P150_003 from PAY150 where P150_001<>'+IntToStr(AItemNo));
  SYSDM.qryQuery.Open;
  while not SYSDM.qryQuery.Eof do
  begin
    lbItem.Items.Add(SYSDM.qryQuery.Fields[0].AsString);
    SYSDM.qryQuery.Next;
  end;

  //取得所有函数
  lbFunction.Clear;
  SYSDM.qryQuery.Close;
  SYSDM.qryQuery.SQL.Clear;
  if AType='CWA' then
    SYSDM.qryQuery.SQL.Add('select S990_002 from SYS990 where S990_003=1')
  else if AType='PAY' then
    SYSDM.qryQuery.SQL.Add('select S990_002 from SYS990 where S990_003 in (1,2)');
  SYSDM.qryQuery.Open;
  while not SYSDM.qryQuery.Eof do
  begin
    lbFunction.Items.Add(SYSDM.qryQuery.Fields[0].AsString);
    SYSDM.qryQuery.Next;
  end;
  if trim(RichEdit1.Text)<>'' then
    RichEdit1.Text:=GetFunct(RichEdit1.Text,AItemID,AItemNm,AType)
  else
    RichEdit1.Text:=AItemNm+':=;';
  RichEdit1.SetFocus;
end;

procedure THwFormulaForm.ScripterCompileError(Sender: TObject;
  var msg: String; row, col: Integer; var ShowException: Boolean);
begin
  //语法错误在：行  列
  ShowMsg(GetDBString('FUN10001010')+IntToStr(Row)+GetDBString('FUN10001011')+IntToStr(Col)+#13+Scripter.SourceCode.Text,1);
  SetCursor(RichEdit1,Col,Row,True);
  Abort;
end;

procedure THwFormulaForm.lbItemDblClick(Sender: TObject);
var
  S:String;
begin
//项目
  S:='{'+lbItem.Items[lbItem.ItemIndex]+'}';
  InsertText(RichEdit1,S);
end;

procedure THwFormulaForm.lbFunctionDblClick(Sender: TObject);
var
  S:String;
begin
//函数
  S:='['+lbFunction.Items[lbFunction.ItemIndex]+']';
  InsertText(RichEdit1,S);
end;

procedure THwFormulaForm.ActUndoExecute(Sender: TObject);
begin
//恢复
  RichEdit1.Undo;
end;

procedure THwFormulaForm.sbIfClick(Sender: TObject);
begin
//如果
  InsertText(RichEdit1,'if ');
end;

procedure THwFormulaForm.sbThenClick(Sender: TObject);
begin
//那么
  InsertText(RichEdit1,'then ');
end;

procedure THwFormulaForm.sbElseClick(Sender: TObject);
begin
//否则
  InsertText(RichEdit1,'else ');
end;

procedure THwFormulaForm.sbOrClick(Sender: TObject);
begin
//或
  InsertText(RichEdit1,'or ');
end;

procedure THwFormulaForm.sbAndClick(Sender: TObject);
begin
//且
  InsertText(RichEdit1,'and ');
end;

procedure THwFormulaForm.SpeedButton6Click(Sender: TObject);
begin
//+
  InsertText(RichEdit1,'+ ');
end;

procedure THwFormulaForm.SpeedButton7Click(Sender: TObject);
begin
//-
  InsertText(RichEdit1,'- ');
end;

procedure THwFormulaForm.SpeedButton8Click(Sender: TObject);
begin
//*
  InsertText(RichEdit1,'* ');
end;

procedure THwFormulaForm.sbDivClick(Sender: TObject);
begin
//
  InsertText(RichEdit1,'/ ');
end;

procedure THwFormulaForm.SpeedButton10Click(Sender: TObject);
begin
//=
  InsertText(RichEdit1,'= ');
end;

procedure THwFormulaForm.SpeedButton11Click(Sender: TObject);
begin
//>
  InsertText(RichEdit1,'> ');
end;

procedure THwFormulaForm.SpeedButton12Click(Sender: TObject);
begin
//<
  InsertText(RichEdit1,'< ');
end;

procedure THwFormulaForm.SpeedButton13Click(Sender: TObject);
begin
//(
  InsertText(RichEdit1,'( ');
end;

procedure THwFormulaForm.SpeedButton14Click(Sender: TObject);
begin
//<>
  InsertText(RichEdit1,'<> ');
end;

procedure THwFormulaForm.SpeedButton15Click(Sender: TObject);
begin
//>=
  InsertText(RichEdit1,'>= ');
end;

procedure THwFormulaForm.SpeedButton16Click(Sender: TObject);
begin
//<=
  InsertText(RichEdit1,'<= ');
end;

procedure THwFormulaForm.SpeedButton17Click(Sender: TObject);
begin
//)
  InsertText(RichEdit1,') ');
end;

procedure THwFormulaForm.RichEdit1Change(Sender: TObject);
begin
  if not Showing then Exit;
  if not Active then Exit;
  CodeColors(RichEdit1,True);
end;

end.