rm_dlgexpr.pas

report machine 2.3 功能强大

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

unit RM_DlgExpr;

{$I RM.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, Buttons {$IFDEF Delphi4}, 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;
    CategoryLB: TListBox;
    VarLB: TListBox;
    Image2: TImage;
    Image1: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    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 CategoryLBDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure CategoryLBClick(Sender: TObject);
    procedure VarLBDblClick(Sender: TObject);
    procedure TreeViewFunctionsChange(Sender: TObject; Node: TTreeNode);
    procedure FormShow(Sender: TObject);
    procedure VarLBClick(Sender: TObject);
  private
    Expr: TEdit;
    FExprResult: integer;
    FDatafieldResult: integer;
    FFuncParamsResult: integer;
    FFuncResult: integer;
    FVariableResult: integer;
    FVal: string;

    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
  end;

function RMGetExpression(ACaption: string; var Value: string;	AParentControl: TWinControl): boolean;

implementation

uses RM_Pars, RM_Class, RM_Const, RM_Const1, RM_Utils, RM_DBRel, DB, RM_Desgn;

{$R *.DFM}

var
  LastDB: string;
  LastCategory: string;

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): boolean;
begin
  with TRMFormExpressionBuilder.Create(Application) do
  try
  	chkUseTableName.Checked := TRMDesignerForm(RMDesigner).UseTableName;
    if AParentControl <> nil then
    begin
      Parent := AParentControl;
      Top := 0;
      Left := 0;
      BorderStyle := bsNone;
      Position := poDesigned;
    end;
    if ACaption <> '' then
      lblHeading.Caption := ACaption;
    Expr.Text := Value;
    Expr.SelStart := 0;
    Expr.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(Expr.Text)
    else
      Value := '';
  finally
		TRMDesignerForm(RMDesigner).UseTableName := chkUseTableName.Checked;
    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;

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));

  Caption := RMLoadStr(rmRes + 700);
  lblHeading.Caption := RMLoadStr(rmRes + 701);
  InsertGroupBox.Caption := RMLoadStr(rmRes + 702);
  btnInsertDataField.Caption := RMLoadStr(rmRes + 703);
  btnInsertVariable.Caption := RMLoadStr(rmRes + 704);
  btnInsertFunction.Caption := RMLoadStr(rmRes + 705);
  btnClearExpr.Caption := RMLoadStr(rmRes + 721);
  Button3.Caption := RMLoadStr(rmRes + 712);

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

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

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

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

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

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

procedure TRMFormExpressionBuilder.SelectFunc(Index: integer);
var
	str: string;
begin
  if (Index < lstFunc.Items.Count) then
  begin
//  	str := RMFunctionLib[lstFunc.Items[lstFunc.ItemIndex]].Description;
		str := RMFunctionLib.GetDescription(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) then
          Text := ParamExpr;

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

function TRMFormExpressionBuilder.GetParams(ParamList: string; var ParamResult: string): boolean;
var
  I: integer;
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;
      Left := 10;
      Top := I * 40;
      Tag := 1;
      case ParamList[I + 1] of
        'N': Caption := RMLoadStr(rmRes + 719);
        'B': Caption := RMLoadStr(rmRes + 718);
        'S': Caption := RMLoadStr(rmRes + 717);
        'V': Caption := RMLoadStr(rmRes + 720);
        'D': Caption := RMLoadStr(rmRes + 716);
        'T': Caption := RMLoadStr(rmRes + 715);
        'E': Caption := RMLoadStr(rmRes + 714);
      end;
      Caption := Format(Caption, [I + 1]);
    end;
    with TEdit.Create(Self) do
    begin
      Parent := FuncParamSB;
      Left := 10;
      Top := I * 40 + 15;
      Width := Parent.Width - 60;
      Tag := I;
    end;
    with TSpeedButton.Create(Self) do
    begin
      Parent := FuncParamSB;
      Left := Parent.Width - 40;
      Width := 20;
      Height := 20;
      Top := I * 40 + 15;
      Caption := '...';
      Tag := I;
      OnClick := GetParamExprClick;
    end;
    FuncParamSB.VertScrollBar.Range := Length(ParamList) * 40;
    FuncParamSB.VertScrollBar.Increment := 40;
  end;

  FFuncParamsResult := 0;
  repeat
    Application.HandleMessage;
  until FFuncParamsResult <> 0;
  Result := FFuncParamsResult = 1;
  if Result then
  begin
    ParamResult := '';
    for I := 0 to FuncParamSB.ControlCount - 1 do
    begin
      if FuncParamSB.Controls[I] is TEdit then
      begin
				if TEdit(FuncParamSB.Controls[I]).Text <> '' then
        begin
	        if ParamResult <> '' then
  	        ParamResult := ParamResult + ',';
    	    ParamResult := ParamResult + TEdit(FuncParamSB.Controls[I]).Text;
        end;  
      end;
    end;
  end;
  while FuncParamSB.ControlCount > 0 do
    FuncParamSB.Controls[0].Free;
end;

function TRMFormExpressionBuilder.GetDatafield(var Field: string): boolean;
begin