rm_editorexpr.pas

这是一个功能强大

{*****************************************}
{                                         }
{          Report Machine v1.0            }
{             Expr Dialog                 }
{                                         }
{*****************************************}

unit RM_EditorExpr;

{$I RM.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, Buttons, RM_Common, RM_Class, RM_DataSet
{$IFDEF COMPILER4_UP}, ImgList{$ENDIF};

type
  TRMFormExpressionBuilder = class(TForm)
    Panel2: TPanel;
    PageControl1: TPageControl;
    TabSheetExpr: TTabSheet;
    TabSheetDatabase: TTabSheet;
    TabSheetVal: TTabSheet;
    TabSheetFunc: TTabSheet;
    lblHeading: TLabel;
    InsertGroupBox: TGroupBox;
    AddPlus: TButton;
    AddMinus: TButton;
    AddMul: TButton;
    AddDiv: TButton;
    AddEqual: TButton;
    AddSmaller: TButton;
    AddLarger: TButton;
    AddNotEqual: TButton;
    AddLessEqual: TButton;
    AddGreaterEqual: TButton;
    AddNot: TButton;
    AddAnd: TButton;
    AddOr: TButton;
    Button3: TButton;
    btnClearExpr: TButton;
    btnOK: TButton;
    btnCancel: TButton;
    SelectVariableGroupBox: TGroupBox;
    btnVariableOK: TButton;
    btnVariableCancel: TButton;
    btnFunctionOK: TButton;
    btnFunctionCancel: TButton;
    FunctionGroupBox: TGroupBox;
    FuncName: TLabel;
    FuncDescription: TLabel;
    lstFunc: TListBox;
    btnDataFieldOK: TButton;
    DataFieldCancelBtn: TButton;
    DatafieldGB: TGroupBox;
    DatasetLabel: TLabel;
    DatafieldLabel: TLabel;
    lstFields: TListBox;
    lstDatasets: TListBox;
    TabSheetFuncParam: TTabSheet;
    GroupBox6: TGroupBox;
    CopyFuncName: TLabel;
    CopyFuncDescription: TLabel;
    FuncParamSB: TScrollBox;
    btnFuncParamOk: TButton;
    btnFuncArgCancel: TButton;
    lstVariableFolder: TListBox;
    lstVariables: TListBox;
    btnInsertDataField: TSpeedButton;
    btnInsertVariable: TSpeedButton;
    btnInsertFunction: TSpeedButton;
    TreeViewFunctions: TTreeView;
    ImageList1: TImageList;
    chkUseTableName: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnClearExprClick(Sender: TObject);
    procedure btnInsertDataFieldClick(Sender: TObject);
    procedure btnDataFieldOKClick(Sender: TObject);
    procedure DataFieldCancelBtnClick(Sender: TObject);
    procedure btnInsertFunctionClick(Sender: TObject);
    procedure btnFunctionOKClick(Sender: TObject);
    procedure btnInsertVariableClick(Sender: TObject);
    procedure btnFunctionCancelClick(Sender: TObject);
    procedure lstDatasetsClick(Sender: TObject);
    procedure AddOrClick(Sender: TObject);
    procedure lstFieldsDblClick(Sender: TObject);
    procedure btnVariableOKClick(Sender: TObject);
    procedure btnVariableCancelClick(Sender: TObject);
    procedure lstFuncDblClick(Sender: TObject);
    procedure btnFuncParamOkClick(Sender: TObject);
    procedure btnFuncArgCancelClick(Sender: TObject);
    procedure lstFuncClick(Sender: TObject);
    procedure lstVariableFolderDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lstVariableFolderClick(Sender: TObject);
    procedure lstVariablesDblClick(Sender: TObject);
    procedure TreeViewFunctionsChange(Sender: TObject; Node: TTreeNode);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    edtExpression: TEdit;
    FExprResult: integer;
    FDatafieldResult: integer;
    FFuncParamsResult: integer;
    FFuncResult: integer;
    FVariableResult: integer;
    FVal: string;
    FFunctionBMP: TBitmap;
    FDataSetBMP, FFieldBMP: TBitmap;
    FVariableFolderBMP, FVariableBMP: TBitmap;
    FReport: TRMReport;
    FDataSet: TRMDataSet;

    function CurDataSet: string;
    procedure GetVariables;
    procedure GetSpecValues;
    function GetParams(ParamList: string; var ParamResult: string): boolean;
    procedure GetParamExprClick(Sender: TObject);
    procedure SelectFunc(Index: integer);

    procedure InsertText(AText: string);
    function GetDatafield(var Field: string): boolean;
    function GetFunc(var Func: string): boolean;
    function GetVariable(var Variable: string): boolean;
    procedure Localize;
  public
    IsScript: Boolean;

    property Report: TRMReport read FReport write FReport;
    property DataSet: TRMDataSet read FDataSet write FDataSet;
  end;

function RMGetExpression(ACaption: string; var Value: string; AParentControl: TWinControl;
  aIsScript: Boolean): boolean;
function RMGetExpression1(ACaption: string; var Value: string; AParentControl: TWinControl;
  aIsScript: Boolean; aReport: TRMReport; aDataSet: TRMDataSet): boolean;


implementation

uses
  RM_Parser, RM_Const, RM_Const1, RM_Utils, RM_Designer;

{$R *.DFM}

var
  FLastVariableFolder: string;

type
  THackReport = class(TRMReport);

function TrimExpr(AExpr: string): string;
begin
  while pos(#13, AExpr) > 0 do
    Delete(AExpr, Pos(#13, AExpr), 2);
  Result := AExpr;
end;

function RMGetExpression(ACaption: string; var Value: string; AParentControl: TWinControl;
  aIsScript: Boolean): boolean;
begin
  with TRMFormExpressionBuilder.Create(Application) do
  try
    DataSet := nil;
    Report := nil;
    isScript := aIsScript;
    chkUseTableName.Checked := RMDesigner.UseTableName;
    if AParentControl <> nil then
    begin
      Parent := AParentControl;
      Top := 0;
      Left := 0;
      BorderStyle := bsNone;
      Position := poDesigned;
    end;
    if ACaption <> '' then
      lblHeading.Caption := ACaption;
    edtExpression.Text := Value;
    edtExpression.SelStart := 0;
    edtExpression.SelLength := Length(Value);
    FExprResult := 0;
    if Parent = nil then
      ShowModal
    else
    begin
      Show;
      repeat
        Application.HandleMessage
      until FExprResult <> 0;
    end;
    Result := FExprResult = 1;
    if Result then
      Value := TrimExpr(edtExpression.Text)
    else
      Value := '';
  finally
    RMDesigner.UseTableName := chkUseTableName.Checked;
    Free;
  end;
end;

function RMGetExpression1(ACaption: string; var Value: string; AParentControl: TWinControl;
  aIsScript: Boolean; aReport: TRMReport; aDataSet: TRMDataSet): boolean;
begin
  with TRMFormExpressionBuilder.Create(Application) do
  try
    isScript := aIsScript;
    DataSet := aDataSet;
    Report := aReport;
    chkUseTableName.Checked := False;
    if AParentControl <> nil then
    begin
      Parent := AParentControl;
      Top := 0;
      Left := 0;
      BorderStyle := bsNone;
      Position := poDesigned;
    end;
    if ACaption <> '' then
      lblHeading.Caption := ACaption;
    edtExpression.Text := Value;
    edtExpression.SelStart := 0;
    edtExpression.SelLength := Length(Value);
    FExprResult := 0;
    if Parent = nil then
      ShowModal
    else
    begin
      Show;
      repeat
        Application.HandleMessage
      until FExprResult <> 0;
    end;
    Result := FExprResult = 1;
    if Result then
      Value := TrimExpr(edtExpression.Text)
    else
      Value := '';
  finally
    Free;
  end;
end;

function AddBrackets(s: string): string;
var
  i: Integer;
begin
  Result := s;
  s := AnsiUpperCase(s);
  for i := 1 to Length(s) do
  begin
    if not (s[i] in ['0'..'9', '_', '.', 'A'..'Z']) then
    begin
      Result := '[' + Result + ']';
      Break;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ 函数处理程序 }

procedure GetFunctionFolder(aList: TStrings); // 函数分类
var
  i, j, k: Integer;
  pfunc: PRMFunctionDesc;
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.Sorted := True;
    for i := 0 to RMAddInFunctionCount - 1 do
    begin
      with RMAddInFunctions(i) do
      begin
        for j := 0 to FunctionList.Count - 1 do
        begin
          pfunc := PRMFunctionDesc(FunctionList[j]);
          if not sl.Find(pfunc.Category, k) then
            sl.Add(pfunc^.Category);
        end;
      end;
    end;

    with THackReport(RMDesigner.Report).InterFunction do
    begin
      for j := 0 to FunctionList.Count - 1 do
      begin
        pfunc := PRMFunctionDesc(FunctionList[j]);
        if not sl.Find(pfunc.Category, k) then
          sl.Add(pfunc^.Category);
      end;
    end;

    sl.Sort;
    aList.Assign(sl);
  finally
    sl.Free;
  end;
end;

procedure GetFunctionList(aCategory: string; aList: TStrings); // 每类函数列表
var
  i, j: Integer;
  pfunc: PRMFunctionDesc;
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    if aCategory = RMLoadStr(SAllCategories) then
      aCategory := '';

    for i := 0 to RMAddInFunctionCount - 1 do
    begin
      with RMAddInFunctions(i) do
      begin
        for j := 0 to FunctionList.Count - 1 do
        begin
          pfunc := PRMFunctionDesc(FunctionList[j]);
          if (aCategory = '') or (AnsiCompareText(pfunc^.Category, aCategory) = 0) then
            sl.Add(pfunc^.FuncName);
        end;
      end;
    end;

    with THackReport(RMDesigner.Report).InterFunction do
    begin
      for j := 0 to FunctionList.Count - 1 do
      begin
        pfunc := PRMFunctionDesc(FunctionList[j]);
        if (aCategory = '') or (AnsiCompareText(pfunc^.Category, aCategory) = 0) then
          sl.Add(pfunc^.FuncName);
      end;
    end;

    sl.Sort;
    aList.Assign(sl);
  finally
    sl.Free;
  end;
end;

function GetFunctionDescription(const FuncName: string): string; // 函数功能描述
var
  i, j: integer;
  pfunc: PRMFunctionDesc;
begin
  Result := '';
  for i := 0 to RMAddInFunctionCount - 1 do
  begin
    with RMAddInFunctions(i) do
    begin
      for j := 0 to FunctionList.Count - 1 do
      begin
        pfunc := PRMFunctionDesc(FunctionList[j]);
        if AnsiCompareText(pfunc^.FuncName, FuncName) = 0 then
        begin
          Result := pfunc^.Description;
          Exit;
        end;
      end;
    end;
  end;

  with THackReport(RMDesigner.Report).InterFunction do
  begin
    for j := 0 to FunctionList.Count - 1 do
    begin
      pfunc := PRMFunctionDesc(FunctionList[j]);
      if AnsiCompareText(pfunc^.FuncName, FuncName) = 0 then
      begin
        Result := pfunc^.Description;
        Exit;
      end;
    end;
  end;
end;

function GetArguments(const FuncName: string): string; // 函数参数
var
  i, j: integer;
  pfunc: PRMFunctionDesc;
begin
  Result := '';
  for i := 0 to RMAddInFunctionCount - 1 do
  begin
    with RMAddInFunctions(i) do
    begin
      for j := 0 to FunctionList.Count - 1 do
      begin
        pfunc := PRMFunctionDesc(FunctionList[j]);
        if AnsiCompareText(pfunc^.FuncName, FuncName) = 0 then
        begin
          Result := pfunc^.FuncPara;
          Exit;
        end;
      end;
    end;
  end;

  with THackReport(RMDesigner.Report).InterFunction do
  begin
    for j := 0 to FunctionList.Count - 1 do
    begin
      pfunc := PRMFunctionDesc(FunctionList[j]);
      if AnsiCompareText(pfunc^.FuncName, FuncName) = 0 then
      begin
        Result := pfunc^.FuncPara;
        Exit;
      end;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TWordWrapEdit }
type
  TWordWrapEdit = class(TEdit)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

procedure TWordWrapEdit.CreateParams(var Params: TCreateParams);
const
  WordWraps: array[Boolean] of LongInt = (0, ES_AUTOHSCROLL);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style and not WordWraps[True] or ES_MULTILINE
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMFormExpressionBuilder}

procedure TRMFormExpressionBuilder.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 700);
  RMSetStrProp(lblHeading, 'Caption', rmRes + 701);
  RMSetStrProp(InsertGroupBox, 'Caption', rmRes + 702);
  RMSetStrProp(btnInsertDataField, 'Caption', rmRes + 703);
  RMSetStrProp(btnInsertVariable, 'Caption', rmRes + 704);
  RMSetStrProp(btnInsertFunction, 'Caption', rmRes + 705);
  RMSetStrProp(btnClearExpr, 'Caption', rmRes + 721);
  RMSetStrProp(Button3, 'Caption', rmRes + 712);

  RMSetStrProp(DatasetLabel, 'Caption', rmRes + 706);
  RMSetStrProp(DatafieldLabel, 'Caption', rmRes + 707);
  RMSetStrProp(DatafieldGB, 'Caption', rmRes + 713);
  btnDataFieldOK.Caption := RMLoadStr(SOK);
  DataFieldCancelBtn.Caption := RMLoadStr(SCancel);

  btnVariableOK.Caption := RMLoadStr(SOK);
  btnVariableCancel.Caption := RMLoadStr(SCancel);
  RMSetStrProp(SelectVariableGroupBox, 'Caption', rmRes + 708);

  RMSetStrProp(btnFunctionOK, 'Caption', rmRes + 709);
  btnFunctionCancel.Caption := RMLoadStr(SCancel);
  RMSetStrProp(FunctionGroupBox, 'Caption', rmRes + 710);

  RMSetStrProp(GroupBox6, 'Caption', rmRes + 711);
  btnFuncParamOk.Caption := RMLoadStr(SOK);
  btnFuncArgCancel.Caption := RMLoadStr(SCancel);
  RMSetStrProp(chkUseTableName, 'Caption', rmRes + 722);

  btnOK.Caption := RMLoadStr(SOK);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

procedure TRMFormExpressionBuilder.InsertText(AText: string);
begin
  edtExpression.SelText := AText;
  edtExpression.SelStart := edtExpression.SelStart + edtExpression.SelLength;
  edtExpression.SelLength := 0;
end;

procedure TRMFormExpressionBuilder.SelectFunc(Index: Integer);
var
  str: string;
begin
  if (Index >= 0) and (Index < lstFunc.Items.Count) then
  begin
    str := GetFunctionDescription(lstFunc.Items[lstFunc.ItemIndex]);
    FuncName.Caption := Copy(str, 1, Pos('|', str) - 1);
    FuncDescription.Caption := Copy(str, Pos('|', str) + 1, 1000);
  end
  else
  begin
    FuncDescription.Caption := '';
    FuncName.Caption := '';
  end;
end;

procedure TRMFormExpressionBuilder.GetParamExprClick(Sender: TObject);
var
  I: integer;
  ParamExpr: string;
begin
  for I := 0 to FuncParamSB.ControlCount - 1 do
  begin
    if (FuncParamSB.Controls[I] is TEdit) and (TEdit(FuncParamSB.Controls[I]).Tag = TSpeedButton(Sender).Tag) then
    begin
      with TEdit(FuncParamSB.Controls[I]) do
      begin
        ParamExpr := Text;
        if RMGetExpression(Format(RMLoadStr(rmRes + 728), [Tag + 1, FuncName.Caption]),
          ParamExpr, Self, Self.IsScript) then
          Text := ParamExpr;

        PageControl1.ActivePage := TabSheetFuncParam;
        SetFocus;
        SelStart := 0;
        SelLength := Length(Text);
        Exit;
      end;
    end;
  end;
end;

type
  THackPage = TRMCustomPage;

function TRMFormExpressionBuilder.GetParams(ParamList: string; var ParamResult: string): boolean;
var
  i, j: integer;
  t: TRMView;
  lStr: string;
begin
  PageControl1.ActivePage := TabSheetFuncParam;
  CopyFuncName.Caption := FuncName.Caption;
  CopyFuncDescription.Caption := FuncDescription.Caption;
  for i := 0 to length(ParamList) - 1 do
  begin
    with TLabel.Create(Self) do
    begin
      Parent := FuncParamSB;