qrexpbld.pas

delphi7报表打印控件源码 可以设计报表

{ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  :: QuickReport 4.0 for Delphi and C++Builder               ::
  ::                                                         ::
  :: QRExpBld.pas - EXPRESSION BUILDER                       ::
  ::                                                         ::
  :: Copyright (c) 2003 A Lochert / QBS Software             ::
  :: All Rights Reserved                                     ::
  ::                                                         ::
  :: web: http://www.qusoft.com                              ::
  ::                                                         ::
  ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }

unit QRExpBld;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, QRExpr, QR4Const;

type
  TQRExpressionBuilder = class(TForm)
    MainPage: TPanel;
    DataFieldPage: TPanel;
    FunctionPage: TPanel;
    FuncParamsPage: TPanel;
    Heading: TLabel;
    GroupBox1: TGroupBox;
    InsertDataFieldBtn: TButton;
    InsertFunctionBtn: TButton;
    InsertVariableBtn: TButton;
    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;
    ValidateBtn: TButton;
    Clear: TButton;
    OK: TButton;
    Cancel: TButton;
    DataFieldOKBtn: TButton;
    DataFieldCancelBtn: TButton;
    DataFieldGB: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    DataSet: TComboBox;
    DataField: TListBox;
    FunctionOKBtn: TButton;
    FunctionCancelBtn: TButton;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    AvailableFields: TListBox;
    GroupBox4: TGroupBox;
    Categories: TListBox;
    Label6: TLabel;
    AvailableFunc: TListBox;
    Label7: TLabel;
    FuncName: TLabel;
    FuncDescription: TLabel;
    GroupBox3: TGroupBox;
    CopyFuncName: TLabel;
    CopyFuncDescription: TLabel;
    FuncParamSB: TScrollBox;
    FuncParamOkBtn: TButton;
    FuncArgCancelBtn: TButton;
    AvailableDatasets: TListBox;
    VariablePage: TPanel;
    GroupBox5: TGroupBox;
    VariableOKBtn: TButton;
    VariableCancelBtn: TButton;
    AvailableVariables: TListBox;
    VariableValue: TLabel;
    Label1: TLabel;
    ModifyVariables: TButton;
    TopPanel: TPanel;
    TopImage: TImage;
    Label8: TLabel;
    Shape1: TShape;
    procedure InsertDataFieldBtnClick(Sender: TObject);
    procedure DataFieldCancelBtnClick(Sender: TObject);
    procedure DataFieldOKBtnClick(Sender: TObject);
    procedure FunctionOKBtnClick(Sender: TObject);
    procedure CategoriesClick(Sender: TObject);
    procedure AvailableFuncClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure InsertFunctionBtnClick(Sender: TObject);
    procedure FuncParamOkBtnClick(Sender: TObject);
    procedure FuncArgCancelBtnClick(Sender: TObject);
    procedure FunctionCancelBtnClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure AddSomeClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure AvailableDatasetsClick(Sender: TObject);
    procedure OKClick(Sender: TObject);
    procedure CancelClick(Sender: TObject);
    procedure ClearClick(Sender: TObject);
    procedure ValidateBtnClick(Sender: TObject);
    procedure InsertVariableBtnClick(Sender: TObject);
    procedure VariableOKBtnClick(Sender: TObject);
    procedure VariableCancelBtnClick(Sender: TObject);
    procedure AvailableVariablesClick(Sender: TObject);
    procedure ModifyVariablesClick(Sender: TObject);
  private
    Expr: TEdit;
    FFuncParamsResult : integer;
    FFuncResult : integer;
    FDatafieldResult : integer;
    FExprResult : integer;
    FDatasetForm : TCustomForm;
    FVariableResult : integer;
    FLocalEnvironment : TQREvEnvironment;
    procedure GetParamExprClick(Sender : TObject);
    procedure GetFunctionsCat(Index : integer);
    procedure SelectFunc(Index : integer);
    procedure InsertText(AText : string);
    procedure PickDataSets;
    procedure PickVariables;
    function GetParams(ParamList : string; var ParamResult : string) : boolean;
    function GetFunc(var Func : string) : boolean;
    function GetDatafield(var Field : string) : boolean;
    function GetVariable(var Variable : string) : boolean;
  public
    property DatasetForm : TCustomForm read FDatasetForm write FDatasetForm;
    property LocalEnvironment : TQREvEnvironment read FLocalEnvironment write FLocalEnvironment;
  end;

  function GetExpression(ACaption : string; var Value : string; ADataSetForm : TCustomForm; AParentControl : TWinControl; ALocalEnvironment : TQREvEnvironment) : boolean;

implementation

uses QRPrntr, QRExtra, Buttons, DB, QREnvEd;

{$R *.DFM}

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

function GetExpression(ACaption : string; var Value : string; ADataSetForm : TCustomForm; AParentControl : TWinControl; ALocalEnvironment : TQREvEnvironment) : boolean;
begin
  with TQRExpressionBuilder.Create(Application) do
  try
    DatasetForm := ADatasetForm;
    LocalEnvironment := ALocalEnvironment;
    if AParentControl <> nil then
    begin
      Parent := AParentControl;
      Top := 0;
      Left := 0;
      BorderStyle := bsNone;
      PickDatasets;
      PickVariables;
      Position := poDesigned;
    end;
    if ACaption <> '' then
      Heading.Caption := ACaption;
    Expr.Text := Value;
    Expr.SelStart := 0;
    Expr.SelLength := Length(Value);
    FExprResult := 0;
    MainPage.BringToFront;
    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
    Free;
  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;

procedure TQRExpressionBuilder.InsertDataFieldBtnClick(Sender: TObject);
var
  AField : string;
begin
  MainPage.Enabled := false;
  if GetDatafield(AField) then
  begin
    MainPage.Enabled := true;
    InsertText(AField);
  end else
    MainPage.Enabled := true;
  MainPage.BringToFront;
  Expr.SetFocus;
end;

procedure TQRExpressionBuilder.DataFieldCancelBtnClick(Sender: TObject);
begin
  FDatafieldResult := 2;
end;

procedure TQRExpressionBuilder.DataFieldOKBtnClick(Sender: TObject);
begin
  FDatafieldResult := 1;
end;

procedure TQRExpressionBuilder.FunctionOKBtnClick(Sender: TObject);
begin
  FFuncResult := 1;
end;

procedure TQRExpressionBuilder.CategoriesClick(Sender: TObject);
begin
  GetFunctionsCat(Categories.ItemIndex);
end;

procedure TQRExpressionBuilder.GetFunctionsCat(Index : integer);
var
  I : integer;
begin
  AvailableFunc.Items.Clear;
  for I:=0 to QRFunctionLibrary.EntryList.Count-1 do
  begin
    with TQRLibraryEntry(QRFunctionLibrary.Entry[I]) do
    begin
      if (Index = 0) or (StrToInt(Copy(Data, 1, 1)) = Index) then
        AvailableFunc.Items.AddObject(Name, TQRLibraryEntry(QRFunctionLibrary.Entry[I]));
    end;
  end;
  SelectFunc(0);
end;

procedure TQRExpressionBuilder.SelectFunc(Index : integer);
var
  AText : string;
begin
  if (Index < AvailableFunc.Items.Count) then
  begin
    AText := TQRLibraryEntry(AvailableFunc.Items.Objects[Index]).Description;
    FuncName.Caption := copy(AText, 1, AnsiPos('|', AText) - 1);
    FuncDescription.Caption := copy(AText,AnsiPos('|', AText) + 1, Length(AText));
  end else
  begin
    FuncDescription.Caption := '';
    FuncName.Caption := '';
  end;
end;

procedure TQRExpressionBuilder.AvailableFuncClick(Sender: TObject);
begin
  SelectFunc(AvailableFunc.ItemIndex);
end;

procedure TQRExpressionBuilder.FormCreate(Sender: TObject);
begin
  GetFunctionsCat(0);
  Expr := TWordWrapEdit.Create(Self);
  with Expr do
  begin
    AutoSize := false;
    Parent := MainPage;
    Top := 36;
    Left := 20;
    Width := 341;
    Height := 91;
  end;
end;

function TQRExpressionBuilder.GetFunc(var Func : string) : boolean;
var
  AllArguments : string;
  Arguments : string;
begin
  FunctionPage.Enabled := true;
  FunctionPage.BringToFront;
  FFuncResult := 0;
  repeat
    Application.HandleMessage
  until FFuncResult <> 0;
  if FFuncResult = 1 then
  begin
    Result := true;
    if (AvailableFunc.ItemIndex >= 0) and
       (AvailableFunc.ItemIndex <= AvailableFunc.Items.Count - 1) then
      with TQRLibraryEntry(AvailableFunc.Items.Objects[AvailableFunc.ItemIndex]) do
      begin
        Func := Name;
        Arguments := Data;
      end;
    if Length(Arguments) > 1 then
    begin
      FunctionPage.Enabled := false;
      if GetParams(Copy(Arguments, 2, length(Arguments)), AllArguments) then
        Func := Func + '(' + AllArguments + ')'
      else
        Result := false;
      FunctionPage.Enabled := true;
    end;