qrctrls.pas

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

{ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  :: QuickReport 4.0 for Delphi and C++Builder               ::
  ::                                                         ::
  :: QRCtrls.pas - PRINTABLE CONTROLS                        ::
  ::                                                         ::
  :: Copyright (c) 2001 A Lochert/QBS Software               ::
  :: All Rights Reserved                                     ::
  ::                                                         ::
  :: web: http://www.qusoft.com                              ::
  :: 15/12/2003 fixed print method of TQRImage               ::
  :: 16/12/2003 Added Richtext export                        ::
  :: 20/12/2003 added TQRMemo expanded height                ::
  :: 21/12/2003 added TQRDBRichText expanded height          ::
  ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }

{$I QRDEFS.INC}
unit QRCtrls;

interface

uses Messages, Windows, Classes, Controls, StdCtrls, SysUtils, Graphics, Buttons,
     Forms, ExtCtrls, Dialogs, Printers, DB, DBtables, ComCtrls, RichEdit,
     QRPrntr, QuickRpt, Qr4Const, QRExpr;

{$R-}
{$B-}

type
  { Forward declarations }
  TQRExpr = class;

  TQRLabelOnPrintEvent = procedure (sender : TObject; var Value : string) of object;

  { TQRCustomLabel - base class for printable text components }
  TQRCustomLabel = class(TQRPrintable)
  private
    FCaptionBased : boolean;
    DoneFormat : boolean;
    FAutoSize : boolean;
    FAutoStretch : boolean;
    FCaption : string;
    FCurrentLine : integer;
    FPrintCaption : string;
    FFontSize : integer;
    FFormattedLines : TStrings;
    FLines : TStrings;
    FOnPrint : TQRLabelOnPrintevent;
    FWordWrap : boolean;
    UpdatingBounds : boolean;
    function GetCaption : string;
    function GetCaptionBased : boolean; virtual;
    procedure SetAutoStretch(Value : boolean);
    procedure SetCaption(Value : string);
    procedure SetLines(Value : TStrings);
    procedure SetWordWrap(Value : boolean);
    procedure PaintToCanvas(aCanvas : TCanvas; aRect : TRect; CanExpand : boolean; LineHeight : integer);
    procedure PrintToCanvas(aCanvas : TCanvas; aLeft, aTop, aWidth, aHeight, LineHeight : extended;
                            CanExpand : boolean);
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  protected
    procedure FormatLines; virtual;
    procedure Loaded; override;
    procedure SetName(const Value: TComponentName); override;
    procedure SetParent(AParent: TWinControl); override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadFontSize(Reader : TReader); virtual;
    procedure WriteFontSize(Writer : TWriter); virtual;
    procedure Paint; override;
    procedure Prepare; override;
    procedure Unprepare; override;
    procedure Print(OfsX, OfsY : integer); override;
    procedure SetAlignment(Value : TAlignment); override;
    property OnPrint : TQRLabelOnPrintEvent read FOnPrint write FOnPrint;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    function GetControlsAlignment: TAlignment; override;
    property CaptionBased : boolean read GetCaptionBased;
    property Alignment;
    property AutoSize : boolean read FAutoSize write FAutoSize;
    property AutoStretch : boolean read FAutoStretch write SetAutoStretch;
    property Caption : string read GetCaption write SetCaption stored true;
    property Color;
    property Font;
    property Lines : TStrings read FLines write SetLines;
    property WordWrap : boolean read FWordWrap write SetWordWrap;
  end;

  { TQRLabel - printable component with published Caption property }
  TQRLabel = class(TQRCustomLabel)
  protected
    function GetEditorClass : TQRPrintableEditorClass; override;
  public
  published
    property Alignment;
    property AlignToBand;
    property AutoSize;
    property AutoStretch;
    property BiDiMode;
    property ParentBiDiMode;
    property Caption;
    property Color;
    property Font;
    property OnPrint;
    property ParentFont;
    property Transparent;
    property WordWrap;
  end;

  { TQRMemo - printable memo component (published Lines property) }
  TQRMemo = class(TQRCustomLabel)
  protected
    function GetCaptionBased : boolean; override;
  public
    procedure Paint; override;
    procedure Print(OfsX, OfsY : integer); override;
    procedure GetExpandedHeight(var newheight : extended );override;
  published
    property Alignment;
    property AlignToBand;
    property AutoSize;
    property AutoStretch;
    property BiDiMode;
    property ParentBiDiMode;
    property Color;
    property Font;
    property Lines;
    property ParentFont;
    property Transparent;
    property WordWrap;
  end;

  { TQRDBText }
  TQRDBText = class(TQRCustomLabel)
  private
    ComboBox : TEdit;
    Field : TField;
    FieldNo : integer;
    FieldOK : boolean;
    DataSourceName : string[30];
    FDataSet : TDataSet;
    FDataField : string;
    FMask : string;
    IsMemo : boolean;
    procedure SetDataSet(Value : TDataSet);
    procedure SetDataField(Value : string);
    procedure SetMask(Value : string);
  protected
    function GetCaptionBased : boolean; override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Prepare; override;
    procedure Print(OfsX, OfsY : integer); override;
    procedure Unprepare; override;
  public
    constructor Create(AOwner : TComponent); override;
    function UseRightToLeftAlignment: boolean; override;
    procedure GetExpandedHeight(var newheight : extended ); override;
    procedure GetFieldString( var DataStr : string); override;
  published
    property Alignment;
    property AlignToBand;
    property AutoSize;
    property AutoStretch;
    property BiDiMode;
    property ParentBiDiMode;
    property Color;
    property DataSet : TDataSet read FDataSet write SetDataSet;
    property DataField : string read FDataField write SetDataField;
    property Font;
    property Mask : string read FMask write SetMask;
    property OnPrint;
    property ParentFont;
    property Transparent;
    property WordWrap;
  end;

  { TQRExpr }
  TQRExpr = class(TQRCustomLabel)
  private
    Evaluator : TQREvaluator;
    FExpression : string;
    FMask : string;
    FMaster : TComponent;
    FResetAfterPrint : boolean;
    function GetValue : TQREvResult;
    procedure SetExpression(Value : string);
    procedure SetMask(Value : string);
  protected
    procedure Prepare; override;
    procedure Unprepare; override;
    procedure QRNotification(Sender : TObject; Operation : TQRNotifyOperation); override;
    procedure Print(OfsX, OfsY : integer); override;
    procedure SetMaster(AComponent : TComponent);
{$ifndef QRSTANDARD}
    function GetEditorClass : TQRPrintableEditorClass; override;
{$endif}
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Reset;
    property Value : TQREvResult read GetValue;
  published
    property Alignment;
    property AlignToBand;
    property AutoSize;
    property AutoStretch;
    property BiDiMode;
    property ParentBiDiMode;
    property Font;
    property Color;
    property Master : TComponent read FMaster write SetMaster;
    property OnPrint;
    property ParentFont;
    property ResetAfterPrint : boolean read FResetAfterPrint write FResetAfterPrint;
    property Transparent;
    property WordWrap;
    property Expression : string read FExpression write SetExpression;
    property Mask : string read FMask write SetMask;
  end;

  { TQRSysData }
  TQRSysDataType = (qrsTime,
                    qrsDate,
                    qrsDateTime,
                    qrsPageNumber,
                    qrsReportTitle,
                    qrsDetailCount,
                    qrsDetailNo);

  TQRSysData = class(TQRCustomLabel)
  private
    FData : TQRSysDataType;
    FText : string;
    procedure SetData(Value : TQRSysDataType);
    procedure SetText(Value : string);
    procedure CreateCaption;
  protected
    procedure Print(OfsX, OfsY : integer); override;
  public
    constructor Create(AOwner : TComponent); override;
  published
    property Alignment;
    property AlignToBand;
    property AutoSize;
    property BiDiMode;
    property ParentBiDiMode;
    property Color;
    property Data : TQRSysDataType read FData write SetData;
    property Font;
    property OnPrint;
    property ParentFont;
    property Text : string read FText write SetText;
    property Transparent;
  end;

  { TQRShape }
  TQRShapeType = (qrsRectangle,qrsCircle,qrsVertLine,qrsHorLine, qrsTopAndBottom, qrsRightAndLeft
           , qrsRoundRect);

  TQRShape = class(TQRPrintable)
  private
    FShape : TQRShapeType;
    FBrush : TBrush;
    FPen : TPen;
    FRoundFactor : single;
    FVertAdjust : integer; 
    procedure SetBrush(Value : TBrush);
    procedure SetPen(Value : TPen);
    procedure SetShape(Value : TQRShapeType);
  protected
    procedure Paint; override;
    procedure Print(OfsX, OfsY : integer); override;
    procedure StyleChanged(sender : TObject);
    procedure SetRoundFactor(value : single);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property Brush : TBrush read FBrush write SetBrush;
    property Height default 65;
    property Pen : TPen read FPen write Setpen;
    property Shape : TQRShapeType Read FShape write SetShape;
    property Width default 65;
    property RoundFactor : single read FRoundFactor write SetRoundFactor;
    property VertAdjust : integer read FVertAdjust write FVertAdjust;
  end;

  { TQRImage }
  TQRImage = class(TQRPrintable)
  private
    FPicture: TPicture;
    FAutoSize: Boolean;
    FStretch: Boolean;
    FCenter: Boolean;
    function GetCanvas: TCanvas;
    procedure PictureChanged(Sender: TObject);
    procedure SetCenter(Value: Boolean);
    procedure SetPicture(Value: TPicture);
    procedure SetStretch(Value: Boolean);
  protected
    procedure SetAutoSize(Value: Boolean);
    function GetPalette: HPALETTE; override;
    procedure Paint; override;
    procedure Print(OfsX, OfsY : integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read GetCanvas;
  published
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    property Center: Boolean read FCenter write SetCenter default False;
    property Picture: TPicture read FPicture write SetPicture;
    property Stretch: Boolean read FStretch write SetStretch default False;
    // QR4
    property Visible;
  end;

  { TQRDBImage }
  TQRDBImage = class(TQRPrintable)
  private
    FField : TField;
    FDataSet : TDataSet;
    FDataField : string;
    FPicture: TPicture;
    FStretch: boolean;
    FCenter: boolean;
    FPictureLoaded: boolean;
    procedure PictureChanged(Sender: TObject);
    procedure SetCenter(Value: Boolean);
    procedure SetDataField(const Value: string);
    procedure SetDataSet(Value: TDataSet);
    procedure SetPicture(Value: TPicture);
    procedure SetStretch(Value: Boolean);
  protected
    function GetPalette: HPALETTE; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure Prepare; override;
    procedure Print(OfsX, OfsY : integer); override;
    procedure UnPrepare; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetExpandedHeight(var newheight : extended ); override;
    procedure GetFieldString( var DataStr : string); override;
    procedure LoadPicture;
    property Field: TField read FField;
    property Picture: TPicture read FPicture write SetPicture;
  published
    property Center: boolean read FCenter write SetCenter default True;
    property DataField: string read FDataField write SetDataField;
    property DataSet: TDataSet read FDataSet write SetDataSet;
    property Stretch: boolean read FStretch write SetStretch default False;
  end;


  { TQRRichEdit - TQRCustomRichEdit descendant with some special settings }
  TQRRichEdit = class(TCustomRichEdit)
  public
    property BorderStyle;
  end;

  { TQRRichText }
  TQRCustomRichText = class(TQRPrintable)
  private
    LastChar : integer;
    FAutoStretch : boolean;
    FParentRichEdit : TRichEdit;
    FRichEdit : TQRRichEdit;
    function GetAlignment : TAlignment;
    function GetColor : TColor;
    function GetFont : TFont;
    function GetLines : TStrings;
    procedure SetColor(Value : TColor);
    procedure SetFont(Value : TFont);
    procedure SetLines(Value : TStrings);
    procedure SetParentRichEdit(Value : TRichEdit);
  protected
    procedure SetAlignment(Value : TAlignment); override;
    property Lines : TStrings read GetLines write SetLines;
    property ParentRichEdit : TRichEdit read FParentRichEdit write SetParentRichEdit;
    procedure Print(OfsX, OfsY : integer); override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight : integer); override;
    function GetControlsAlignment: TAlignment; override;
  published
    property Alignment : TAlignment read GetAlignment write SetAlignment;
    property AutoStretch : boolean read FAutoStretch write FAutoStretch;
    property Color : TColor read GetColor write SetColor;
    property Font : TFont read GetFont write SetFont;
  end;

  { TQRRichText }
  TQRRichText = class(TQRCustomRichText)
  published
    property Lines;
    property ParentRichEdit;
  end;

  { TQRDBRichText }
  TQRDBRichText = class(TQRCustomRichText)
  private
    Field : TField;
    FDataField : string;
    FDataSet : TDataSet;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetDataSet(Value : TDataSet);
    procedure Prepare; override;
    procedure Unprepare; override;
    procedure Print(OfsX, OfsY : integer); override;
  published
    procedure GetExpandedHeight( var newheight : extended);override;
    procedure GetFieldString( var DataStr : string);override;
    property DataField : string read FDataField write FDataField;
    property DataSet : TDataSet read FDataSet write SetDataSet;
  end;

  { TQRExprMemo }
  TQRMerger = class
  private
    FOrgLines : TStrings;
    FStrippedLines : TStrings;
    FMergedLines : TStrings;
    FMerged : boolean;
    FPrepared : boolean;
    Expressions : TList;
    FDataSets : TList;
  protected
    function GetOrgLines : TStrings;
    function GetMergedLines : TStrings;
    procedure SetOrgLines(Value : TStrings);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Prepare;
    procedure Merge;
    procedure Unprepare;
    property Lines : TStrings read GetOrgLines write SetOrgLines;
    property MergedLines : TStrings read GetMergedLines;
    property Merged : boolean read FMerged;
    property Prepared : boolean read FPrepared;
    property DataSets :TList read FDataSets write FDataSets;
  end;