ReportPart控件的新版！续动态表列打印问题！ (0分)

  • 主题发起人 主题发起人 黎永欢
  • 开始时间 开始时间
黎

黎永欢

Unregistered / Unconfirmed
GUEST, unregistred user!
请更新两个单元：rpColnBar.pas，rpReg.pas
// rpColnBar.pas ////////////////////////////////////////////////////////////
{***********************************************}
{* Report Part Components For Quick Report *}
{* *}
{* TrpColumnBar Sources *}
{* *}
{* Copyright L.Y.H *}
{***********************************************}
unit rpColnBar;

interface

uses
Windows, Classes, SysUtils, Graphics, StdCtrls, DBGrids, DB, QuickRpt, QrCtrls;

type
TrpColumnDiagonal = class;

TrpColumnFrame = class;

TrpColumn = class;

TrpColumns = class;

TrpColumnBar = class;

TrpColumnDiagonalClass = class of TrpColumnDiagonal;

TrpColumnFrameClass = class of TrpColumnFrame;

TrpColumnClass = class of TrpColumn;

TrpColumnsClass = class of TrpColumns;

TrpColumnBarClass = class of TrpColumnBar;

TrpColumnDiagonalStyle = (rpd2D, rpd3D);

TrpColumnKind = (
rpkText,
rpkDataField,
rpkDiagonal,
rpkDate,
rpkTime,
rpkDateTime,
rpkPageNumber,
rpkReportTitle,
rpkDetailCount,
rpkDetailNo
);

TrpRelatedKind = (
rprAlignment,
rprColor,
rprEnabled,
rprIndex,
rprLayout,
rprVisible,
rprWidth
);

TrpRelatedKinds = set of TrpRelatedKind;

TrpColumnNotifyEvent = procedure (Sender: TObject; Column: TrpColumn) of object;

TrpColumnPaintEvent = procedure (Sender: TObject; Column: TrpColumn; ACanvas: TCanvas; const ARect: TRect) of object;

TrpColumnFindEvent = procedure (Sender: TObject; Column: TrpColumn; var Finished: Boolean) of object;

TrpColumnLoadEvent = procedure (Sender: TObject; Column: TrpColumn; Source: TObject) of object;

// TrpColumnDiagonal /////////////////////////////////////////////////////////////////
TrpColumnDiagonal = class(TPersistent)
private
FColumn: TrpColumn;
FStyle: TrpColumnDiagonalStyle;
FTextFirst: string;
FTextSecond: string;
FTextThird: string;
procedure SetStyle(const Value: TrpColumnDiagonalStyle);
procedure SetTextFirst(const Value: string);
procedure SetTextSecond(const Value: string);
procedure SetTextThird(const Value: string);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AColumn: TrpColumn); virtual;
published
property Style: TrpColumnDiagonalStyle read FStyle write SetStyle default rpd2D;
property TextFirst: string read FTextFirst write SetTextFirst;
property TextSecond: string read FTextSecond write SetTextSecond;
property TextThird: string read FTextThird write SetTextThird;
end;

// TrpColumnFrame //////////////////////////////////////////////////////////////
TrpColumnFrame = class(TPersistent)
private
FColumn: TrpColumn;
FDrawLeft: Boolean;
FDrawTop: Boolean;
FDrawRight: Boolean;
FDrawBottom: Boolean;
FColorLeft: TColor;
FColorTop: TColor;
FColorRight: TColor;
FColorBottom: TColor;
procedure SetDrawLeft(const Value: Boolean);
procedure SetDrawTop(const Value: Boolean);
procedure SetDrawRight(const Value: Boolean);
procedure SetDrawBottom(const Value: Boolean);
procedure SetColorLeft(const Value: TColor);
procedure SetColorTop(const Value: TColor);
procedure SetColorRight(const Value: TColor);
procedure SetColorBottom(const Value: TColor);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AColumn: TrpColumn); virtual;
published
property DrawLeft: Boolean read FDrawLeft write SetDrawLeft default True;
property DrawTop: Boolean read FDrawTop write SetDrawTop default True;
property DrawRight: Boolean read FDrawRight write SetDrawRight default True;
property DrawBottom: Boolean read FDrawBottom write SetDrawBottom default True;
property ColorLeft: TColor read FColorLeft write SetColorLeft default clBlack;
property ColorTop: TColor read FColorTop write SetColorTop default clBlack;
property ColorRight: TColor read FColorRight write SetColorRight default clBlack;
property ColorBottom: TColor read FColorBottom write SetColorBottom default clBlack;
end;

// TrpColumn ///////////////////////////////////////////////////////////////////
TrpColumn = class(TCollectionItem)
private
FAlignment: TAlignment;
FColor: TColor;
FDiagonal: TrpColumnDiagonal;
FEllipsis: Boolean;
FEnabled: Boolean;
FFrame: TrpColumnFrame;
FFont: TFont;
FFormatText: string;
FKind: TrpColumnKind;
FLayout: TTextLayout;
FText: string;
FWidth: Integer;
FWordWrap: Boolean;
FMarginLeft: Integer;
FMarginRight: Integer;
FVisible: Boolean;
FDataField: string;
FDataSet: TDataSet;
FTag: Integer;
FLevel: Integer;
FName: string;
FChildHeight: Integer;
FChildColumns: TrpColumns;
FChildDependent: Boolean;
FRelatedKinds: TrpRelatedKinds;
FRelatedColumn: TrpColumn;
FExtraObject: TObject;
procedure SetAlignment(const Value: TAlignment);
procedure SetColor(const Value: TColor);
procedure SetDiagonal(const Value: TrpColumnDiagonal);
procedure SetEllipsis(const Value: Boolean);
procedure SetEnabled(const Value: Boolean);
procedure SetFrame(const Value: TrpColumnFrame);
procedure SetFont(const Value: TFont);
procedure SetFormatText(const Value: string);
procedure SetKind(const Value: TrpColumnKind);
procedure SetLayout(const Value: TTextLayout);
procedure SetText(const Value: string);
procedure SetWidth(const Value: Integer);
function GetHeight: Integer;
procedure SetHeight(const Value: Integer);
procedure SetWordWrap(const Value: Boolean);
procedure SetMarginLeft(const Value: Integer);
procedure SetMarginRight(const Value: Integer);
procedure SetVisible(const Value: Boolean);
procedure SetDataField(const Value: string);
procedure SetDataSet(const Value: TDataSet);
function GetField: TField;
function GetFieldOK: Boolean;
function GetColumnBar: TrpColumnBar;
function GetParentColumn: TrpColumn;
procedure SetName(const Value: string);
procedure SetChildHeight(const Value: Integer);
procedure SetChildColumns(const Value: TrpColumns);
procedure SetChildDependent(const Value: Boolean);
procedure SetRelatedKinds(const Value: TrpRelatedKinds);
procedure SetRelatedColumn(const Value: TrpColumn);
procedure StyleChange(Sender: TObject);
protected
procedure SetIndex(Value: Integer); override;
function GetDisplayName: string; override;
public
property ColumnBar: TrpColumnBar read GetColumnBar;
property Field: TField read GetField;
property FieldOK: Boolean read GetFieldOK;
property Level: Integer read FLevel;
property RelatedColumn: TrpColumn read FRelatedColumn write SetRelatedColumn;
property ExtraObject: TObject read FExtraObject write FExtraObject; { Additional object property }
function GetPaintText: string;
function GetPrintText: string;
function HasChild: Boolean;
function HasVisibleChild: Boolean;
property ParentColumn: TrpColumn read GetParentColumn;
procedure Show;
procedure Hide;
procedure UpdateRelatedColumn;
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
published
property Index stored False;
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Color: TColor read FColor write SetColor;
property Diagonal: TrpColumnDiagonal read FDiagonal write SetDiagonal;
property Ellipsis: Boolean read FEllipsis write SetEllipsis default False;
property Enabled: Boolean read FEnabled write SetEnabled default True;
property Frame: TrpColumnFrame read FFrame write SetFrame;
property Font: TFont read FFont write SetFont;
property FormatText: string read FFormatText write SetFormatText;
property Kind: TrpColumnKind read FKind write SetKind default rpkText;
property Layout: TTextLayout read FLayout write SetLayout default tlCenter;
property Text: string read FText write SetText;
property Width: Integer read FWidth write SetWidth default 50;
property Height: Integer read GetHeight write SetHeight stored False;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
property MarginLeft: Integer read FMarginLeft write SetMarginLeft default 0;
property MarginRight: Integer read FMarginRight write SetMarginRight default 0;
property Visible: Boolean read FVisible write SetVisible default True;
property DataField: string read FDataField write SetDataField;
property DataSet: TDataSet read FDataSet write SetDataSet;
property Tag: Integer read FTag write FTag default 0;
property Name: string read FName write SetName;
property ChildHeight: Integer read FChildHeight write SetChildHeight;
property ChildColumns: TrpColumns read FChildColumns write SetChildColumns;
property ChildDependent: Boolean read FChildDependent write SetChildDependent default False;
property RelatedKinds: TrpRelatedKinds read FRelatedKinds write SetRelatedKinds default [rprEnabled, rprIndex, rprVisible, rprWidth];
end;

// TrpColumns //////////////////////////////////////////////////////////////////
TrpColumns = class(TCollection)
private
FParent: TrpColumn;
FColumnBar: TrpColumnBar;
function GetItem(Index: Integer): TrpColumn;
procedure SetItem(Index: Integer; Value: TrpColumn);
function GetWidth: Integer;
protected
function GetOwner: TPersistent; override;
public
property Parent: TrpColumn read FParent;
property ColumnBar: TrpColumnBar read FColumnBar;
property Items[Index: Integer]: TrpColumn read GetItem write SetItem; default;
property Width: Integer read GetWidth;
procedure LoadFromDataSet(ADataSet: TDataSet; const OnlyFieldName: Boolean = False);
procedure LoadFromDBGrid(ADBGrid: TDBGrid; const OnlyTitleCaption: Boolean = False);
constructor Create(AColumnBar: TrpColumnBar; AParent: TrpColumn);
function Add: TrpColumn;
procedure Update(Item: TCollectionItem); override;
procedure UpdateParent;
end;

// TrpColumnBar ////////////////////////////////////////////////////////////////
TrpColumnBar = class(TQRPrintable)
private
FAutoFitting: Boolean;
FBrush: TBrush;
FPen: TPen;
FColumns: TrpColumns;
FDrawFrame: Boolean;
FOnPrint: TNotifyEvent;
FOnColPaint: TrpColumnPaintEvent;
FOnColPrint: TrpColumnNotifyEvent;
FOnColShow: TrpColumnNotifyEvent;
FOnColHide: TrpColumnNotifyEvent;
FOnColResize: TrpColumnNotifyEvent;
FOnColMove: TrpColumnNotifyEvent;
FOnColFind: TrpColumnFindEvent;
FOnColLoad: TrpColumnLoadEvent;
procedure SetAutoFitting(const Value: Boolean);
procedure SetBrush(const Value: TBrush);
procedure SetPen(const Value: TPen);
procedure SetColumns(const Value: TrpColumns);
procedure SetDrawFrame(const Value: Boolean);
procedure StyleChange(Sender: TObject);
protected
procedure Paint; override;
procedure Print(OfsX, OfsY: Integer); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
procedure DoPrint;
procedure DoColPaint(Column: TrpColumn; ARect: TRect);
procedure DoColPrint(Column: TrpColumn);
procedure DoColShow(Column: TrpColumn);
procedure DoColHide(Column: TrpColumn);
procedure DoColResize(Column: TrpColumn);
procedure DoColMove(Column: TrpColumn);
procedure DoColFind(Column: TrpColumn; var Finished: Boolean);
procedure DoColLoad(Column: TrpColumn; Source: TObject);
procedure FindColumn; { Using with the OnColFind event }
function ColumnByName(ColumnName: string): TrpColumn;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property AlignToBand;
property Font;
property ParentFont;
property AutoFitting: Boolean read FAutoFitting write SetAutoFitting default False;
property Brush: TBrush read FBrush write SetBrush;
property Pen: TPen read FPen write SetPen;
property Columns: TrpColumns read FColumns write SetColumns;
property DrawFrame: Boolean read FDrawFrame write SetDrawFrame default True;
property OnPrint: TNotifyEvent read FOnPrint write FOnPrint;
property OnColPaint: TrpColumnPaintEvent read FOnColPaint write FOnColPaint;
property OnColPrint: TrpColumnNotifyEvent read FOnColPrint write FOnColPrint;
property OnColShow: TrpColumnNotifyEvent read FOnColShow write FOnColShow;
property OnColHide: TrpColumnNotifyEvent read FOnColHide write FOnColHide;
property OnColResize: TrpColumnNotifyEvent read FOnColResize write FOnColResize;
property OnColMove: TrpColumnNotifyEvent read FOnColMove write FOnColMove;
property OnColFind: TrpColumnFindEvent read FOnColFind write FOnColFind;
property OnColLoad: TrpColumnLoadEvent read FOnColLoad write FOnColLoad;
end;

implementation

uses
rpCommon;

const
ColumnKinds: array [TrpColumnKind] of string = (
'(Text)',
'(Data Field)',
'(Diagonal %s)',
'(Date)',
'(Time)',
'(Date Time)',
'(Page Number)',
'(Report Title)',
'(Detail Count)',
'(Detail No)'
);

// TrpColumnDiagonal /////////////////////////////////////////////////////////////////
procedure TrpColumnDiagonal.SetStyle(const Value: TrpColumnDiagonalStyle);
begin
if Value <> FStyle then
begin
FStyle := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;
end;

procedure TrpColumnDiagonal.SetTextFirst(const Value: string);
begin
FTextFirst := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;

procedure TrpColumnDiagonal.SetTextSecond(const Value: string);
begin
FTextSecond := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;

procedure TrpColumnDiagonal.SetTextThird(const Value: string);
begin
FTextThird := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;

function TrpColumnDiagonal.GetOwner: TPersistent;
begin
Result := FColumn;
end;

constructor TrpColumnDiagonal.Create(AColumn: TrpColumn);
begin
inherited Create;
FColumn := AColumn;
FStyle := rpd2D;
FTextFirst := '';
FTextSecond := '';
FTextThird := '';
end;

// TrpColumnFrame //////////////////////////////////////////////////////////////
procedure TrpColumnFrame.SetDrawLeft(const Value: Boolean);
begin
if Value <> FDrawLeft then
begin
FDrawLeft := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;
end;

procedure TrpColumnFrame.SetDrawTop(const Value: Boolean);
begin
if Value <> FDrawTop then
begin
FDrawTop := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;
end;

procedure TrpColumnFrame.SetDrawRight(const Value: Boolean);
begin
if Value <> FDrawRight then
begin
FDrawRight := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;
end;

procedure TrpColumnFrame.SetDrawBottom(const Value: Boolean);
begin
if Value <> FDrawBottom then
begin
FDrawBottom := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;
end;

procedure TrpColumnFrame.SetColorLeft(const Value: TColor);
begin
if Value <> FColorLeft then
begin
FColorLeft := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;
end;

procedure TrpColumnFrame.SetColorTop(const Value: TColor);
begin
if Value <> FColorTop then
begin
FColorTop := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;
end;

procedure TrpColumnFrame.SetColorRight(const Value: TColor);
begin
if Value <> FColorRight then
begin
FColorRight := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;
end;

procedure TrpColumnFrame.SetColorBottom(const Value: TColor);
begin
if Value <> FColorBottom then
begin
FColorBottom := Value;
if Assigned(FColumn) then FColumn.Changed(False);
end;
end;

function TrpColumnFrame.GetOwner: TPersistent;
begin
Result := FColumn;
end;

constructor TrpColumnFrame.Create(AColumn: TrpColumn);
begin
inherited Create;
FColumn := AColumn;
FDrawLeft := True;
FDrawTop := True;
FDrawRight := True;
FDrawBottom := True;
FColorLeft := clBlack;
FColorTop := clBlack;
FColorRight := clBlack;
FColorBottom := clBlack;
end;

// TrpColumn ///////////////////////////////////////////////////////////////////
procedure TrpColumn.SetAlignment(const Value: TAlignment);
begin
if Value <> FAlignment then
begin
FAlignment := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetColor(const Value: TColor);
begin
if Value <> FColor then
begin
FColor := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetDiagonal(const Value: TrpColumnDiagonal);
begin
FDiagonal.Assign(Value);
Changed(False);
end;

procedure TrpColumn.SetEllipsis(const Value: Boolean);
begin
if Value <> FEllipsis then
begin
FEllipsis := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetEnabled(const Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetFrame(const Value: TrpColumnFrame);
begin
FFrame.Assign(Value);
Changed(False);
end;

procedure TrpColumn.SetFont(const Value: TFont);
begin
FFont.Assign(Value);
Changed(False);
end;

procedure TrpColumn.SetFormatText(const Value: string);
begin
FFormatText := Value;
Changed(False);
end;

procedure TrpColumn.SetKind(const Value: TrpColumnKind);
begin
if Value <> FKind then
begin
FKind := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetLayout(const Value: TTextLayout);
begin
if Value <> FLayout then
begin
FLayout := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetText(const Value: string);
begin
FText := Value;
Changed(False);
end;

procedure TrpColumn.SetWidth(const Value: Integer);
begin
if (Value <> FWidth) and (Value >= 0) then
begin
FWidth := Value;
Changed(False);
ColumnBar.DoColResize(Self);
end;
end;

function TrpColumn.GetHeight: Integer;
begin
if Assigned(ParentColumn) then
Result := ParentColumn.ChildHeight
else
Result := ColumnBar.Height;
end;

procedure TrpColumn.SetHeight(const Value: Integer);
begin
if Assigned(ParentColumn) then
ParentColumn.ChildHeight := Value
else
ColumnBar.Height := Value;
end;

procedure TrpColumn.SetWordWrap(const Value: Boolean);
begin
if Value <> FWordWrap then
begin
FWordWrap := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetMarginLeft(const Value: Integer);
begin
if (Value <> FMarginLeft) and (Value >= 0) then
begin
FMarginLeft := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetMarginRight(const Value: Integer);
begin
if (Value <> FMarginRight) and (Value >= 0) then
begin
FMarginRight := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetVisible(const Value: Boolean);
begin
if Value <> FVisible then
begin
FVisible := Value;
Changed(False);
if FVisible then
ColumnBar.DoColShow(Self)
else
ColumnBar.DoColHide(Self);
end;
end;

procedure TrpColumn.SetDataField(const Value: string);
begin
FDataField := Value;
if FieldOK and not (csLoading in ColumnBar.ComponentState) then
begin
FAlignment := Field.Alignment;
end;
Changed(False);
end;

procedure TrpColumn.SetDataSet(const Value: TDataSet);
begin
if Value <> FDataSet then
begin
FDataSet := Value;
if FieldOK and not (csLoading in ColumnBar.ComponentState) then
begin
FAlignment := Field.Alignment;
end;
Changed(False);
end;
end;

function TrpColumn.GetField: TField;
begin
if FieldOK then
Result := FDataSet.FieldByName(FDataField)
else
Result := nil;
end;

function TrpColumn.GetFieldOK: Boolean;
begin
Result := Assigned(FDataSet) and FDataSet.Active and Assigned(FDataSet.FindField(FDataField));
end;

procedure TrpColumn.SetName(const Value: string);
begin
FName := Trim(Value);
end;

procedure TrpColumn.SetChildHeight(const Value: Integer);
begin
if (Value <> FChildHeight) and (Value >= 0) then
begin
FChildHeight := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetChildColumns(const Value: TrpColumns);
begin
FChildColumns.Assign(Value);
end;

procedure TrpColumn.SetChildDependent(const Value: Boolean);
begin
if Value <> FChildDependent then
begin
FChildDependent := Value;
if FChildDependent then FChildColumns.UpdateParent;
end;
end;

procedure TrpColumn.SetRelatedKinds(const Value: TrpRelatedKinds);
begin
if Value <> FRelatedKinds then
begin
FRelatedKinds := Value;
Changed(False);
end;
end;

procedure TrpColumn.SetRelatedColumn(const Value: TrpColumn);
begin
if (Value <> FRelatedColumn) and (Value <> Self) then
begin
FRelatedColumn := Value;
Changed(False);
end;
end;

procedure TrpColumn.StyleChange(Sender: TObject);
begin
Changed(False);
end;

procedure TrpColumn.SetIndex(Value: Integer);
begin
if (Value <> Index) and (Value > - 1) and (Value < Collection.Count) then
begin
inherited SetIndex(Value);
ColumnBar.DoColMove(Self);
Changed(False);
end;
end;

function TrpColumn.GetDisplayName: string;
begin
if FKind <> rpkDiagonal then Result := ColumnKinds[FKind];
case FKind of
rpkText: if FText <> '' then Result := FText;
rpkDataField:
if FDataField <> '' then
if Assigned(FDataSet) then
Result := Format('** %s - %s **', [FDataSet.Name, FDataField])
else
Result := Format('** %s **', [FDataField]);
rpkDiagonal:
case FDiagonal.Style of
rpd2D: Result := Format(ColumnKinds[FKind], ['2D']);
rpd3D: Result := Format(ColumnKinds[FKind], ['3D']);
end;
end;
if FName <> '' then Result := Format('%s (Name = %s)', [Result, FName]);
if HasChild then Result := Format('%s --> (%d children)', [Result, FChildColumns.Count]);
end;

function TrpColumn.GetColumnBar: TrpColumnBar;
begin
Result := TrpColumns(Collection).ColumnBar;
end;

function TrpColumn.GetParentColumn: TrpColumn;
begin
Result := TrpColumns(Collection).Parent;
end;

function TrpColumn.GetPaintText: string;
begin
Result := '';
case FKind of
rpkText: Result := FFormatText + FText;
rpkDataField:
begin
if FDataField <> '' then
Result := Format('(%s)', [FDataField])
else
Result := ColumnKinds[rpkDataField];
Result := FFormatText + Result;
end;
rpkDiagonal: { No Result Text };
else
Result := ColumnKinds[FKind];
end;
end;

function TrpColumn.GetPrintText: string;
begin
Result := '';
with ColumnBar do
case FKind of
rpkText: Result := FFormatText + FText;
rpkDataField:
begin
if FieldOK then
if (Field is TBlobField) and (TBlobField(Field).BlobType = ftMemo) then
Result := TBlobField(Field).Value
else
Result := Field.DisplayText;
Result := FFormatText + Result;
end;
rpkDiagonal: { No Result Text };
rpkDate: Result := FormatDateTime(FFormatText, Date);
rpkTime:
if Trim(FFormatText) <> '' then
Result := FormatDateTime(FFormatText, Time)
else
Result := FormatDateTime('hh:nn:ss', Time);
rpkDateTime: Result := FormatDateTime(FFormatText, Now);
rpkPageNumber: Result := FormatFloat(FFormatText, ParentReport.PageNumber);
rpkReportTitle: Result := FormatText + ParentReport.ReportTitle;
rpkDetailCount:
if ParentReport is TQuickRep then
Result := FormatFloat(FFormatText, TQuickRep(ParentReport).RecordCount);
rpkDetailNo:
if ParentReport is TQuickRep then
Result := FormatFloat(FFormatText, TQuickRep(ParentReport).RecordNumber);
end;
end;

function TrpColumn.HasChild: Boolean;
begin
Result := FChildColumns.Count > 0;
end;

function TrpColumn.HasVisibleChild: Boolean;
var
I: Integer;
begin
I := 0;
Result := False;
while (I < FChildColumns.Count) and not Result do
begin
Result := FChildColumns.Visible;
Inc(I);
end;
end;

procedure TrpColumn.Show;
begin
Visible := True;
end;

procedure TrpColumn.Hide;
begin
Visible := False;
end;

procedure TrpColumn.UpdateRelatedColumn;
begin
if not (csDesigning in ColumnBar.ComponentState) and Assigned(FRelatedColumn) then
begin
if rprAlignment in FRelatedKinds then FRelatedColumn.Alignment := FAlignment;
if rprColor in FRelatedKinds then FRelatedColumn.Color := FColor;
if rprEnabled in FRelatedKinds then FRelatedColumn.Enabled := FEnabled;
if rprIndex in FRelatedKinds then FRelatedColumn.Index := Index;
if rprLayout in FRelatedKinds then FRelatedColumn.Layout := FLayout;
if rprVisible in FRelatedKinds then FRelatedColumn.Visible := FVisible;
if rprWidth in FRelatedKinds then FRelatedColumn.Width := FWidth;
end;
end;

constructor TrpColumn.Create(ACollection: TCollection);
begin
inherited;
FAlignment := taLeftJustify;
FColor := ColumnBar.Brush.Color;
FDiagonal := TrpColumnDiagonal.Create(Self);
FEllipsis := False;
FEnabled := True;
FFrame := TrpColumnFrame.Create(Self);
FFont := TFont.Create;
FFont.OnChange := StyleChange;
FFont.Assign(ColumnBar.Font);
FFormatText := '';
FKind := rpkText;
FLayout := tlCenter;
FText := '';
FWidth := 50;
FWordWrap := False;
FMarginLeft := 0;
FMarginRight := 0;
FVisible := True;
FDataField := '';
FDataSet := nil;
FTag := 0;
if Assigned(ParentColumn) then
FLevel := ParentColumn.Level + 1
else
FLevel := 0;
FName := '';
FChildHeight := 15;
FChildColumns := TrpColumns.Create(ColumnBar, Self);
FChildDependent := False;
FRelatedKinds := [rprEnabled, rprIndex, rprVisible, rprWidth];
FRelatedColumn := nil;
FExtraObject := nil;
end;

destructor TrpColumn.Destroy;
begin
FDiagonal.Free;
FFrame.Free;
FFont.Free;
FChildColumns.Free;
inherited;
end;

// TrpColumns //////////////////////////////////////////////////////////////////
function TrpColumns.GetItem(Index: Integer): TrpColumn;
begin
Result := TrpColumn(inherited GetItem(Index));
end;

procedure TrpColumns.SetItem(Index: Integer; Value: TrpColumn);
begin
inherited SetItem(Index, Value);
end;

function TrpColumns.GetWidth: Integer;
var
I, V, W: Integer;
begin
V := 0;
W := 0;
for I := 0 to Count - 1 do
if Items.Visible then
begin
Inc(V);
Inc(W, Items.Width);
end;
Result := W + V - 1;
end;

function TrpColumns.GetOwner: TPersistent;
begin
if Assigned(FParent) then
Result := FParent
else
Result := FColumnBar;
end;

procedure TrpColumns.LoadFromDataSet(ADataSet: TDataSet; const OnlyFieldName: Boolean = False);
var
I, WN, WV: Integer;
AColumn: TrpColumn;
TM: TTextMetric;
begin
if Assigned(ADataSet) then
begin
Clear;
with FColumnBar do
begin
Canvas.Font.Assign(Font);
GetTextMetrics(Canvas.Handle, TM);
with ADataSet do
for I := 0 to Fields.Count - 1 do
begin
AColumn := Add;
if OnlyFieldName then
begin
AColumn.Kind := rpkText;
AColumn.Text := Fields.DisplayName;
end
else begin
AColumn.Kind := rpkDataField;
AColumn.DataSet := ADataSet;
AColumn.DataField := Fields.FieldName;
end;
WN := Canvas.TextWidth(Fields.DisplayName);
WV := Fields.DisplayWidth * (Canvas.TextWidth('0') - TM.tmOverhang) + TM.tmOverhang + 4;
if WN < WV then
AColumn.Width := WV
else
AColumn.Width := WN;
AColumn.Visible := Fields.Visible;
AColumn.Alignment := Fields.Alignment;
DoColLoad(AColumn, ADataSet);
end;
end;
end;
end;

procedure TrpColumns.LoadFromDBGrid(ADBGrid: TDBGrid; const OnlyTitleCaption: Boolean = False);
var
I: Integer;
AColumn: TrpColumn;
begin
if Assigned(ADBGrid) and Assigned(ADBGrid.DataSource) and Assigned(ADBGrid.DataSource.DataSet) then
begin
Clear;
for I := 0 to ADBGrid.Columns.Count - 1 do
begin
AColumn := Add;
if OnlyTitleCaption then
begin
AColumn.Kind := rpkText;
AColumn.Text := ADBGrid.Columns.Title.Caption;
AColumn.Alignment := ADBGrid.Columns.Title.Alignment;
end
else begin
AColumn.Kind := rpkDataField;
AColumn.DataSet := ADBGrid.DataSource.DataSet;
AColumn.DataField := ADBGrid.Columns.FieldName;
AColumn.Alignment := ADBGrid.Columns.Alignment;
end;
AColumn.Width := ADBGrid.Columns.Width;
AColumn.Visible := ADBGrid.Columns.Visible;
FColumnBar.DoColLoad(AColumn, ADBGrid);
end;
end;
end;

constructor TrpColumns.Create(AColumnBar: TrpColumnBar; AParent: TrpColumn);
begin
inherited Create(TrpColumn);
FColumnBar := AColumnBar;
FParent := AParent;
end;

function TrpColumns.Add: TrpColumn;
begin
Result := TrpColumn(inherited Add);
end;

procedure TrpColumns.Update(Item: TCollectionItem);
begin
FColumnBar.Invalidate;
UpdateParent;
if Assigned(Item) then TrpColumn(Item).UpdateRelatedColumn;
end;

procedure TrpColumns.UpdateParent;
var
I, V, W: Integer;
begin
if Assigned(FParent) and FParent.ChildDependent then
begin
V := 0;
W := 0;
for I := 0 to Count - 1 do
if Items.Visible then
begin
Inc(V);
Inc(W, Items.Width);
end;
FParent.Visible := V > 0;
FParent.Width := W + V - 1;
end;
end;

// TrpColumnBar ////////////////////////////////////////////////////////////////
procedure TrpColumnBar.SetAutoFitting(const Value: Boolean);
begin
if Value <> FAutoFitting then
begin
FAutoFitting := Value;
Invalidate;
end;
end;

procedure TrpColumnBar.SetBrush(const Value: TBrush);
begin
FBrush.Assign(Value);
end;

procedure TrpColumnBar.SetPen(const Value: TPen);
begin
FPen.Assign(Value);
end;

procedure TrpColumnBar.SetColumns(const Value: TrpColumns);
begin
FColumns.Assign(Value);
end;

procedure TrpColumnBar.SetDrawFrame(const Value: Boolean);
begin
if Value <> FDrawFrame then
begin
FDrawFrame := Value;
Invalidate;
end;
end;

procedure TrpColumnBar.StyleChange(Sender: TObject);

procedure UpdateColumnsStyle(AColumns: TrpColumns);
var
I: Integer;
begin
Invalidate;
with AColumns do
if Sender = Font then
begin
ParentFont := False;
for I := 0 to Count - 1 do
begin
Items.Font.Assign(Font);
if Items.HasChild then UpdateColumnsStyle(Items.ChildColumns);
end;
end else
if Sender = FBrush then
begin
for I := 0 to Count - 1 do
begin
Items.Color := FBrush.Color;
if Items.HasChild then UpdateColumnsStyle(Items.ChildColumns);
end;
end else
if Sender = FPen then
begin
for I := 0 to Count - 1 do
begin
Items.Frame.ColorLeft := FPen.Color;
Items.Frame.ColorTop := FPen.Color;
Items.Frame.ColorRight := FPen.Color;
Items.Frame.ColorBottom := FPen.Color;
if Items.HasChild then UpdateColumnsStyle(Items.ChildColumns);
end;
end;
end;

begin
if not (csLoading in ComponentState) then UpdateColumnsStyle(FColumns);
end;

procedure TrpColumnBar.Paint;

procedure PaintColumnFrame(const ARect: TRect; AColumn: TrpColumn);
begin
with Canvas, AColumn.Frame do
begin
if DrawLeft then
begin
Pen.Color := ColorLeft;
Rectangle(ARect.Left, ARect.Top, ARect.Left + 1, ARect.Bottom);
end;

if DrawTop then
begin
Pen.Color := ColorTop;
Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Top + 1);
end;

if DrawRight then
begin
Pen.Color := ColorRight;
Rectangle(ARect.Right - 1, ARect.Top, ARect.Right, ARect.Bottom);
end;

if DrawBottom then
begin
Pen.Color := ColorBottom;
Rectangle(ARect.Left, ARect.Bottom - 1, ARect.Right, ARect.Bottom);
end;
end;
Canvas.Pen.Color := FPen.Color;
end;

procedure PaintText(const AText: string; const ARect: TRect; AColumn: TrpColumn);
begin
with Canvas do
begin
Font.Assign(AColumn.Font);
Font.Size := AColumn.Font.Size;
Font.Height := AColumn.Font.Height;
end;
DrawTextToCanvas(
Canvas,
AText,
ARect,
AColumn.Alignment,
AColumn.Layout,
AColumn.Ellipsis,
AColumn.WordWrap,
AColumn.MarginLeft,
AColumn.MarginRight
);
end;

procedure PaintColumns(AColumns: TrpColumns; const ARect: TRect);
var
I, Last: Integer;
BreakDrawColumn: Boolean;
ColFrameRect, ColTextRect: TRect;
begin
with AColumns do
begin
BreakDrawColumn := False;
ColFrameRect := Rect(ARect.Left, ARect.Top, ARect.Left, ARect.Bottom);

I := 0;
Last := - 1;
while I < Count do
begin
if Items.Visible then Last := I;
Inc(I);
end;

I := 0;
while (I <= Last) and not BreakDrawColumn do
begin
if Items.Visible then
begin
if ColFrameRect.Left >= ARect.Right then Break;

Canvas.Brush.Color := Items.Color;

ColFrameRect.Right := ColFrameRect.Left + Items.Width + 2;

if ColFrameRect.Right >= ARect.Right then
begin
BreakDrawColumn := True;
ColFrameRect.Right := ARect.Right;
end;

if (I = Last) and (ColFrameRect.Right < ARect.Right) and (FAutoFitting or Assigned(Items.ParentColumn)) then
begin
ColFrameRect.Right := ARect.Right;
end;

ColTextRect := Rect(
ColFrameRect.Left + 4, ColFrameRect.Top + 4,
ColFrameRect.Right - 4, ColFrameRect.Bottom - 4
);

if Items.HasVisibleChild then
begin
Dec(ColTextRect.Bottom, Items.ChildHeight - 2);
end;

DoColPaint(Items, ColFrameRect);

if FDrawFrame then
begin
Canvas.FillRect(Rect(ColFrameRect.Left + 1, ColFrameRect.Top + 1,
ColFrameRect.Right, ColFrameRect.Bottom - 1));
PaintColumnFrame(ColFrameRect, Items)
end else
Canvas.FillRect(ColFrameRect);

PaintGrayText(Canvas, IntToStr(Items.Index), ColFrameRect);

if Items.Enabled then
if Items.Kind = rpkDiagonal then
case Items.Diagonal.Style of
rpd2D:
begin
if Items.HasVisibleChild then
Canvas.Polyline([
Point(ColFrameRect.Left, ColFrameRect.Top),
Point(ColFrameRect.Right, ColFrameRect.Bottom - Items.ChildHeight)
])
else
Canvas.Polyline([
Point(ColFrameRect.Left, ColFrameRect.Top),
Point(ColFrameRect.Right - 1, ColFrameRect.Bottom - 1)
]);

PaintText(
Items.Diagonal.TextFirst,
Rect(
(ColTextRect.Left + ColTextRect.Right) div 2, ColTextRect.Top,
ColTextRect.Right, (ColTextRect.Top + ColTextRect.Bottom) div 2
),
Items
);

PaintText(
Items.Diagonal.TextSecond,
Rect(
ColTextRect.Left, (ColTextRect.Top + ColTextRect.Bottom) div 2,
(ColTextRect.Left + ColTextRect.Right) div 2, ColTextRect.Bottom
),
Items
);
end;

rpd3D:
begin
if Items.HasVisibleChild then
Canvas.Polyline([
Point((ColFrameRect.Left + ColFrameRect.Right) div 2, ColFrameRect.Top),
Point(ColFrameRect.Right, ColFrameRect.Bottom - Items.ChildHeight),
Point(ColFrameRect.Left, (2 * ColFrameRect.Top + ColFrameRect.Bottom - Items.ChildHeight) div 3)
])
else
Canvas.Polyline([
Point((ColFrameRect.Left + ColFrameRect.Right) div 2, ColFrameRect.Top),
Point(ColFrameRect.Right - 1, ColFrameRect.Bottom - 1),
Point(ColFrameRect.Left, (2 * ColFrameRect.Top + ColFrameRect.Bottom) div 3)
]);

PaintText(
Items.Diagonal.TextFirst,
Rect(
(ColTextRect.Left + 3 * ColTextRect.Right) div 4, ColTextRect.Top,
ColTextRect.Right, (ColTextRect.Top + ColTextRect.Bottom) div 2
),
Items
);

PaintText(
Items.Diagonal.TextSecond,
Rect(
ColTextRect.Left, ColTextRect.Top,
(ColTextRect.Left + ColTextRect.Right) div 2, (2 * ColTextRect.Top + ColTextRect.Bottom) div 3
),
Items
);

PaintText(
Items.Diagonal.TextThird,
Rect(
ColTextRect.Left, (ColTextRect.Top + 2 * ColTextRect.Bottom) div 3,
(ColTextRect.Left + ColTextRect.Right) div 2, ColTextRect.Bottom
),
Items
);
end;
end else
PaintText(Items.GetPaintText, ColTextRect, Items);

if Items.HasChild then
PaintColumns(
Items.ChildColumns,
Rect(
ColFrameRect.Left, ColFrameRect.Bottom - Items.ChildHeight,
ColFrameRect.Right, ColFrameRect.Bottom)
);

ColFrameRect.Left := ColFrameRect.Right - 1;
end;
Inc(I);
end;
if AColumns = FColumns then
with Rect(0, 0, Self.Width, Self.Height) do
begin
PaintGrayText(Canvas, 'Empty', Rect(ColFrameRect.Right, Top, Right, Bottom), taCenter, tlCenter);
end;
end;
end;

begin { The begin of Paint procedure }
with Canvas do
begin
PaintGrayRect(Canvas, Rect(0, 0, Self.Width, Self.Height));
if FColumns.Count > 0 then
begin
Brush.Assign(FBrush);
Pen.Assign(FPen);
Pen.Width := 1;
PaintColumns(FColumns, Rect(0, 0, Self.Width, Self.Height));
end else
PaintGrayText(Canvas, 'Empty', Rect(0, 0, Self.Width, Self.Height), taCenter, tlCenter);
end;
end;

procedure TrpColumnBar.Print(OfsX, OfsY: Integer);

function GetPrintWidth(const AWidth: Extended): Integer;
begin
with QRPrinter do
Result := XSize(Size.Width / Width * AWidth);
end;

function GetPrintHeight(const AHeight: Extended): Integer;
begin
with QRPrinter do
Result := YSize(Size.Height / Height * AHeight);
end;

function GetPrintRect(const ARect: TRect): TRect;
begin
with QRPrinter do
Result := Rect(
XPos(OfsX + Size.Left) + GetPrintWidth(ARect.Left), YPos(OfsY + Size.Top) + GetPrintHeight(ARect.Top),
XPos(OfsX + Size.Left) + GetPrintWidth(ARect.Right), YPos(OfsY + Size.Top) + GetPrintHeight(ARect.Bottom));
end;

procedure PrintColumnFrame(const ARect: TRect; AColumn: TrpColumn);
begin
with QRPrinter.Canvas, AColumn.Frame do
begin
if DrawLeft then
begin
Pen.Color := ColorLeft;
Rectangle(ARect.Left, ARect.Top, ARect.Left + 1, ARect.Bottom);
end;

if DrawTop then
begin
Pen.Color := ColorTop;
Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Top + 1);
end;

if DrawRight then
begin
Pen.Color := ColorRight;
Rectangle(ARect.Right - 1, ARect.Top, ARect.Right, ARect.Bottom);
end;

if DrawBottom then
begin
Pen.Color := ColorBottom;
Rectangle(ARect.Left, ARect.Bottom - 1, ARect.Right, ARect.Bottom);
end;
end;
QRPrinter.Canvas.Pen.Color := FPen.Color;
end;

procedure PrintText(const AText: string; const ARect: TRect; AColumn: TrpColumn);
begin
with QRPrinter.Canvas do
begin
Font.Assign(AColumn.Font);
Font.Size := GetPrintWidth(AColumn.Font.Size);
Font.Height := GetPrintHeight(AColumn.Font.Height);
end;
DrawTextToCanvas(
QRPrinter.Canvas,
AText,
ARect,
AColumn.Alignment,
AColumn.Layout,
AColumn.Ellipsis,
AColumn.WordWrap,
GetPrintWidth(AColumn.MarginLeft),
GetPrintWidth(AColumn.MarginRight)
);
end;

procedure PrintColumns(AColumns: TrpColumns; const ARect: TRect);
var
I, Last: Integer;
BreakDrawColumn: Boolean;
ColFrameRect, ColTextRect: TRect;
ColFramePrintRect, ColTextPrintRect: TRect;
begin
with AColumns, QRPrinter do
begin
BreakDrawColumn := False;
ColFrameRect := Rect(ARect.Left, ARect.Top, ARect.Left, ARect.Bottom);

I := 0;
Last := - 1;
while I < Count do
begin
if Items.Visible then Last := I;
Inc(I);
end;

I := 0;
while (I <= Last) and not BreakDrawColumn do
begin
if Items.Visible then
begin
DoColPrint(Items);

Canvas.Brush.Color := Items.Color;

ColFrameRect.Right := ColFrameRect.Left + Items.Width + 2;

if ColFrameRect.Right >= ARect.Right then
begin
BreakDrawColumn := True;
ColFrameRect.Right := ARect.Right;
end;

if (I = Last) and (ColFrameRect.Right < ARect.Right) and (FAutoFitting or Assigned(Items.ParentColumn)) then
begin
ColFrameRect.Right := ARect.Right;
end;

ColTextRect := Rect(
ColFrameRect.Left + 4, ColFrameRect.Top + 4,
ColFrameRect.Right - 4, ColFrameRect.Bottom - 4
);

if Items.HasVisibleChild then
begin
Dec(ColTextRect.Bottom, Items.ChildHeight - 2);
end;

ColFramePrintRect := GetPrintRect(ColFrameRect);
ColTextPrintRect := GetPrintRect(ColTextRect);

if FDrawFrame then
begin
Canvas.FillRect(Rect(ColFramePrintRect.Left + 1, ColFramePrintRect.Top + 1,
ColFramePrintRect.Right, ColFramePrintRect.Bottom));
PrintColumnFrame(ColFramePrintRect, Items);
end else
Canvas.FillRect(ColFramePrintRect);

if Items.Enabled then
if Items.Kind = rpkDiagonal then
case Items.Diagonal.Style of
rpd2D:
begin
if Items.HasVisibleChild then
Canvas.Polyline([
Point(ColFramePrintRect.Left, ColFramePrintRect.Top),
Point(ColFramePrintRect.Right, ColFramePrintRect.Bottom - GetPrintHeight(Items.ChildHeight))
])
else
Canvas.Polyline([
Point(ColFramePrintRect.Left, ColFramePrintRect.Top),
Point(ColFramePrintRect.Right - 1, ColFramePrintRect.Bottom - 1)
]);

PrintText(
Items.Diagonal.TextFirst,
Rect(
(ColTextPrintRect.Left + ColTextPrintRect.Right) div 2, ColTextPrintRect.Top,
ColTextPrintRect.Right, (ColTextPrintRect.Top + ColTextPrintRect.Bottom) div 2
),
Items
);

PrintText(
Items.Diagonal.TextSecond,
Rect(
ColTextPrintRect.Left, (ColTextPrintRect.Top + ColTextPrintRect.Bottom) div 2,
(ColTextPrintRect.Left + ColTextPrintRect.Right) div 2, ColTextPrintRect.Bottom
),
Items
);
end;

rpd3D:
begin
if Items.HasVisibleChild then
Canvas.Polyline([
Point((ColFramePrintRect.Left + ColFramePrintRect.Right) div 2, ColFramePrintRect.Top),
Point(ColFramePrintRect.Right, ColFramePrintRect.Bottom - Items.ChildHeight),
Point(ColFramePrintRect.Left, (2 * ColFramePrintRect.Top + ColFramePrintRect.Bottom - Items.ChildHeight) div 3)
])
else
Canvas.Polyline([
Point((ColFramePrintRect.Left + ColFramePrintRect.Right) div 2, ColFramePrintRect.Top),
Point(ColFramePrintRect.Right - 1, ColFramePrintRect.Bottom - 1),
Point(ColFramePrintRect.Left, (2 * ColFramePrintRect.Top + ColFramePrintRect.Bottom) div 3)
]);

PrintText(
Items.Diagonal.TextFirst,
Rect(
(ColTextPrintRect.Left + 3 * ColTextPrintRect.Right) div 4, ColTextPrintRect.Top,
ColTextPrintRect.Right, (ColTextPrintRect.Top + ColTextPrintRect.Bottom) div 2
),
Items
);

PrintText(
Items.Diagonal.TextSecond,
Rect(
ColTextPrintRect.Left, ColTextPrintRect.Top,
(ColTextPrintRect.Left + ColTextPrintRect.Right) div 2, (2 * ColTextPrintRect.Top + ColTextPrintRect.Bottom) div 3
),
Items
);

PrintText(
Items.Diagonal.TextThird,
Rect(
ColTextPrintRect.Left, (ColTextPrintRect.Top + 2 * ColTextPrintRect.Bottom) div 3,
(ColTextPrintRect.Left + ColTextPrintRect.Right) div 2, ColTextPrintRect.Bottom
),
Items
);
end;
end else
PrintText(Items.GetPrintText, ColTextPrintRect, Items);

if Items.HasChild then
PrintColumns(
Items.ChildColumns,
Rect(
ColFrameRect.Left, ColFrameRect.Bottom - Items.ChildHeight,
ColFrameRect.Right, ColFrameRect.Bottom)
);

ColFrameRect.Left := ColFrameRect.Right - 1;
end;
Inc(I);
end;
end;
end;

begin { The begin of Print procedure }
if ParentReport.FinalPass and IsEnabled then
begin
with QRPrinter.Canvas do
begin
DoPrint;
Brush.Assign(FBrush);
Pen.Assign(FPen);
Pen.Width := 1;
end;
PrintColumns(FColumns, Rect(0, 0, Width, Height));
end;
end;

procedure TrpColumnBar.Notification(AComponent: TComponent; Operation: TOperation);

procedure RemoveColumnsDataSet(AColumns: TrpColumns);
var
I: Integer;
begin
with AColumns do
for I := 0 to Count - 1 do
begin
if Items.DataSet = AComponent then Items.DataSet := nil;
if Items.HasChild then RemoveColumnsDataSet(Items.ChildColumns);
end;
end;

begin
inherited;
if Operation = opRemove then
if AComponent is TDataSet then RemoveColumnsDataSet(FColumns);
end;

procedure TrpColumnBar.DoPrint;
begin
if not (csDesigning in ComponentState) and Assigned(FOnPrint) then FOnPrint(Self);
end;

procedure TrpColumnBar.DoColPaint(Column: TrpColumn; ARect: TRect);
begin
if not (csDesigning in ComponentState) and Assigned(FOnColPaint) then FOnColPaint(Self, Column, Canvas, ARect);
end;

procedure TrpColumnBar.DoColPrint(Column: TrpColumn);
begin
if not (csDesigning in ComponentState) and Assigned(FOnColPrint) then FOnColPrint(Self, Column);
end;

procedure TrpColumnBar.DoColShow(Column: TrpColumn);
begin
if not (csDesigning in ComponentState) and Assigned(FOnColShow) then FOnColShow(Self, Column);
end;

procedure TrpColumnBar.DoColHide(Column: TrpColumn);
begin
if not (csDesigning in ComponentState) and Assigned(FOnColHide) then FOnColHide(Self, Column);
end;

procedure TrpColumnBar.DoColResize(Column: TrpColumn);
begin
if not (csDesigning in ComponentState) and Assigned(FOnColResize) then FOnColResize(Self, Column);
end;

procedure TrpColumnBar.DoColMove(Column: TrpColumn);
begin
if not (csDesigning in ComponentState) and Assigned(FOnColMove) then FOnColMove(Self, Column);
end;

procedure TrpColumnBar.DoColFind(Column: TrpColumn; var Finished: Boolean);
begin
if not (csDesigning in ComponentState) and Assigned(FOnColFind) then FOnColFind(Self, Column, Finished);
end;

procedure TrpColumnBar.DoColLoad(Column: TrpColumn; Source: TObject);
begin
if not (csDesigning in ComponentState) and Assigned(FOnColLoad) then FOnColLoad(Self, Column, Source);
end;

procedure TrpColumnBar.FindColumn; { Using with the OnColFind event }
var
Finished: Boolean;

procedure FindNextColumn(AColumns: TrpColumns);
var
I: Integer;
begin
I := 0;
while (I < AColumns.Count) and not Finished do
begin
DoColFind(AColumns, Finished);
if AColumns.HasChild then FindNextColumn(AColumns.ChildColumns);
Inc(I);
end;
end;

begin
if Assigned(FOnColFind) then
begin
Finished := False;
FindNextColumn(FColumns);
end;
end;

function TrpColumnBar.ColumnByName(ColumnName: string): TrpColumn;
var
Finished: Boolean;

procedure FindNextColumn(AColumns: TrpColumns);
var
I: Integer;
begin
I := 0;
while (I < AColumns.Count) and not Finished do
begin
if LowerCase(Trim(AColumns.Name)) = LowerCase(ColumnName) then
begin
Result := AColumns;
Finished := True;
end;
if AColumns.HasChild then FindNextColumn(AColumns.ChildColumns);
Inc(I);
end;
end;

begin
Result := nil;
Finished := False;
ColumnName := Trim(ColumnName);
if ColumnName <> '' then FindNextColumn(FColumns);
end;

constructor TrpColumnBar.Create(AOwner: TComponent);
begin
inherited;
FAutoFitting := False;
FBrush := TBrush.Create;
FPen := TPen.Create;
FPen.Style := psSolid;
Font.OnChange := StyleChange;
FBrush.OnChange := StyleChange;
FPen.OnChange := StyleChange;
FColumns := TrpColumns.Create(Self, nil);
FDrawFrame := True;
FOnPrint := nil;
FOnColPaint := nil;
FOnColPrint := nil;
FOnColShow := nil;
FOnColHide := nil;
FOnColResize := nil;
FOnColFind := nil;
Width := 400;
Height := 30;
end;

destructor TrpColumnBar.Destroy;
begin
FBrush.Free;
FPen.Free;
FColumns.Free;
inherited;
end;

end.

 
谢谢：
 
请给我来一份
Bdl832@msn.com
 
更正了TrpText, TrpDBText, TrpReportInfo的显示混乱的Bug，请更新rpTextCtrls.pas单元。

{***********************************************}
{* Report Part Components For Quick Report *}
{* *}
{* TrpText, TrpDBText, TrpReportInfo Sources *}
{* *}
{* Copyright L.Y.H *}
{***********************************************}
unit rpTextCtrls;

interface

uses
Windows, Classes, SysUtils, Graphics, StdCtrls, DB, QuickRpt, QrCtrls;

type
TrpInfoKind = (
rpiNone,
rpiDate,
rpiTime,
rpiDateTime,
rpiPageNumber,
rpiReportTitle,
rpiDetailCount,
rpiDetailNo
);

// TrpCustomText ///////////////////////////////////////////////////////////////
TrpCustomText = class(TQRPrintable)
private
FEllipsis: Boolean;
FLayout: TTextLayout;
FWordWrap: Boolean;
FMarginLeft: Integer;
FMarginRight: Integer;
FOnPrint: TNotifyEvent;
procedure SetEllipsis(const Value: Boolean);
procedure SetLayout(const Value: TTextLayout);
procedure SetWordWrap(const Value: Boolean);
procedure SetMarginLeft(const Value: Integer);
procedure SetMarginRight(const Value: Integer);
protected
function GetPaintText: string; virtual; abstract;
function GetPrintText: string; virtual; abstract;
procedure Paint; override;
procedure Print(OfsX, OfsY: Integer); override;
public
procedure DoPrint;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property Alignment;
property Color;
property Font;
property ParentFont;
property Transparent default False;
property Ellipsis: Boolean read FEllipsis write SetEllipsis default False;
property Layout: TTextLayout read FLayout write SetLayout default tlCenter;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
property MarginLeft: Integer read FMarginLeft write SetMarginLeft default 0;
property MarginRight: Integer read FMarginRight write SetMarginRight default 0;
property OnPrint: TNotifyEvent read FOnPrint write FOnPrint;
end;

// TrpText /////////////////////////////////////////////////////////////////////
TrpText = class(TrpCustomText)
private
FText: string;
procedure SetText(const Value: string);
protected
function GetPaintText: string; override;
function GetPrintText: string; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Text: string read FText write SetText;
end;

// TrpDBText ///////////////////////////////////////////////////////////////////
TrpDBText = class(TrpCustomText)
private
FDataField: string;
FDataSet: TDataSet;
FFormatText: string;
procedure SetDataField(const Value: string);
procedure SetDataSet(const Value: TDataSet);
function GetField: TField;
function GetFieldOK: Boolean;
procedure SetFormatText(const Value: string);
protected
function GetPaintText: string; override;
function GetPrintText: string; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
property Field: TField read GetField;
property FieldOK: Boolean read GetFieldOK;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property DataField: string read FDataField write SetDataField;
property DataSet: TDataSet read FDataSet write SetDataSet;
property FormatText: string read FFormatText write SetFormatText;
end;

// TrpReportInfo ///////////////////////////////////////////////////////////////
TrpReportInfo = class(TrpCustomText)
private
FFormatText: string;
FKind: TrpInfoKind;
procedure SetFormatText(const Value: string);
procedure SetKind(const Value: TrpInfoKind);
protected
function GetPaintText: string; override;
function GetPrintText: string; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property FormatText: string read FFormatText write SetFormatText;
property Kind: TrpInfoKind read FKind write SetKind default rpiNone;
end;

implementation

uses
rpCommon;

// TrpCustomText ///////////////////////////////////////////////////////////////
procedure TrpCustomText.SetEllipsis(const Value: Boolean);
begin
if Value <> FEllipsis then
begin
FEllipsis := Value;
Invalidate;
end;
end;

procedure TrpCustomText.SetLayout(const Value: TTextLayout);
begin
if Value <> FLayout then
begin
FLayout := Value;
Invalidate;
end;
end;

procedure TrpCustomText.SetWordWrap(const Value: Boolean);
begin
if Value <> FWordWrap then
begin
FWordWrap := Value;
Invalidate;
end;
end;

procedure TrpCustomText.SetMarginLeft(const Value: Integer);
begin
if (Value <> FMarginLeft) and (Value >= 0) then
begin
FMarginLeft := Value;
Invalidate;
end;
end;

procedure TrpCustomText.SetMarginRight(const Value: Integer);
begin
if (Value <> FMarginRight) and (Value >= 0) then
begin
FMarginRight := Value;
Invalidate;
end;
end;

procedure TrpCustomText.Paint;
begin
Canvas.Brush.Assign(Brush);
Canvas.Font.Assign(Font);
Canvas.FillRect(ClientRect);
PaintGrayFrame(Canvas, Rect(0, 0, Width, Height));
DrawTextToCanvas(Canvas, GetPaintText, Rect(0, 0, Width, Height), Alignment, FLayout, FEllipsis,
FWordWrap, FMarginLeft, FMarginRight);
end;

procedure TrpCustomText.Print(OfsX, OfsY: Integer);

function GetPrintWidth(const AWidth: Extended): Integer;
begin
with QRPrinter do
Result := XSize(Size.Width / Width * AWidth);
end;

function GetPrintHeight(const AHeight: Extended): Integer;
begin
with QRPrinter do
Result := YSize(Size.Height / Height * AHeight);
end;

function GetPrintRect(const ARect: TRect): TRect;
begin
with QRPrinter do
Result := Rect(
XPos(OfsX + Size.Left) + GetPrintWidth(ARect.Left), YPos(OfsY + Size.Top) + GetPrintHeight(ARect.Top),
XPos(OfsX + Size.Left) + GetPrintWidth(ARect.Right), YPos(OfsY + Size.Top) + GetPrintHeight(ARect.Bottom));
end;

begin
if ParentReport.FinalPass and IsEnabled then
with QRPrinter do
begin
DoPrint;
Canvas.Brush.Assign(Brush);
Canvas.Font.Assign(Font);
Canvas.Font.Size := GetPrintWidth(Font.Size);
Canvas.Font.Height := GetPrintHeight(Font.Height);
if not Transparent then Canvas.FillRect(GetPrintRect(Rect(0, 0, Self.Width, Self.Height)));
DrawTextToCanvas(Canvas, GetPrintText, GetPrintRect(Rect(0, 0, Self.Width, Self.Height)),
Alignment,FLayout, FEllipsis, FWordWrap, GetPrintWidth(FMarginLeft),
GetPrintWidth(FMarginRight));
end;
end;

procedure TrpCustomText.DoPrint;
begin
if not (csDesigning in ComponentState) and Assigned(FOnPrint) then FOnPrint(Self);
end;

constructor TrpCustomText.Create(AOwner: TComponent);
begin
inherited;
FEllipsis := False;
FLayout := tlCenter;
FWordWrap := False;
FMarginLeft := 0;
FMarginRight := 0;
Height := 20;
Width := 100;
Transparent := False;
end;

destructor TrpCustomText.Destroy;
begin
inherited;
end;

// TrpText /////////////////////////////////////////////////////////////////////
procedure TrpText.SetText(const Value: string);
begin
FText := Value;
Invalidate;
end;

function TrpText.GetPaintText: string;
begin
Result := FText;
end;

function TrpText.GetPrintText: string;
begin
Result := FText;
end;

constructor TrpText.Create(AOwner: TComponent);
begin
inherited;
FText := '';
end;

destructor TrpText.Destroy;
begin
inherited;
end;

// TrpDBText ///////////////////////////////////////////////////////////////////
procedure TrpDBText.SetDataField(const Value: string);
begin
FDataField := Value;
if FieldOK and not (csLoading in ComponentState) then
begin
Alignment := Field.Alignment;
end;
Invalidate;
end;

procedure TrpDBText.SetDataSet(const Value: TDataSet);
begin
if Value <> FDataSet then
begin
FDataSet := Value;
if FieldOK and not (csLoading in ComponentState) then
begin
Alignment := Field.Alignment;
end;
Invalidate;
end;
end;

function TrpDBText.GetField: TField;
begin
if FieldOK then
Result := FDataSet.FieldByName(FDataField)
else
Result := nil;
end;

function TrpDBText.GetFieldOK: Boolean;
begin
Result := Assigned(FDataSet) and FDataSet.Active and Assigned(FDataSet.FindField(FDataField));
end;

procedure TrpDBText.SetFormatText(const Value: string);
begin
FFormatText := Value;
Invalidate;
end;

function TrpDBText.GetPaintText: string;
begin
if FDataField <> '' then
Result := Format('%s(%s)', [FFormatText, FDataField])
else
Result := FFormatText + '(No Field)';
end;

function TrpDBText.GetPrintText: string;
begin
if FieldOK then
if (Field is TBlobField) and (TBlobField(Field).BlobType = ftMemo) then
Result := TBlobField(Field).Value
else
Result := Field.DisplayText
else
Result := '';
Result := FFormatText + Result;
end;

procedure TrpDBText.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (AComponent = FDataSet) and (Operation = opRemove) then FDataSet := nil;
end;

constructor TrpDBText.Create(AOwner: TComponent);
begin
inherited;
FDataField := '';
FDataSet := nil;
FFormatText := '';
end;

destructor TrpDBText.Destroy;
begin
inherited;
end;

// TrpReportInfo ///////////////////////////////////////////////////////////////
procedure TrpReportInfo.SetFormatText(const Value: string);
begin
FFormatText := Value;
Invalidate;
end;

procedure TrpReportInfo.SetKind(const Value: TrpInfoKind);
begin
if Value <> FKind then
begin
FKind := Value;
Invalidate;
end;
end;

function TrpReportInfo.GetPaintText: string;
begin
case FKind of
rpiNone: Result := '(None)';
rpiDate: Result := '(Date)';
rpiTime: Result := '(Time)';
rpiDateTime: Result := '(Date Time)';
rpiPageNumber: Result := '(Page Number)';
rpiReportTitle: Result := '(Report Title)';
rpiDetailCount: Result := '(Detail Count)';
rpiDetailNo: Result := '(Detail No)';
else
Result := '';
end;
end;

function TrpReportInfo.GetPrintText: string;
begin
case FKind of
rpiNone: Result := '';
rpiDate: Result := FormatDateTime(FFormatText, Date);
rpiTime:
if Trim(FFormatText) <> '' then
Result := FormatDateTime(FFormatText, Time)
else
Result := FormatDateTime('hh:nn:ss', Time);
rpiDateTime: Result := FormatDateTime(FFormatText, Now);
rpiPageNumber: Result := FormatFloat(FFormatText, ParentReport.PageNumber);
rpiReportTitle: Result := FormatText + ParentReport.ReportTitle;
rpiDetailCount:
if ParentReport is TQuickRep then
Result := FormatFloat(FFormatText, TQuickRep(ParentReport).RecordCount);
rpiDetailNo:
if ParentReport is TQuickRep then
Result := FormatFloat(FFormatText, TQuickRep(ParentReport).RecordNumber);
else
Result := '';
end;
end;

constructor TrpReportInfo.Create(AOwner: TComponent);
begin
inherited;
FFormatText := '';
FKind := rpiNone;
end;

destructor TrpReportInfo.Destroy;
begin
inherited;
end;

end.
 
// rpReg.pas ///////////////////////////////////////////////////////////

{***********************************************}
{* Report Part Components For Quick Report *}
{* *}
{* Register Sources *}
{* *}
{* Copyright L.Y.H *}
{***********************************************}
unit rpReg;

interface

uses
Classes, {$IFDEF VER140}DesignIntf, DesignEditors{$ELSE}DsgnIntf{$ENDIF},
ColnEdit, Controls, Forms, Dialogs, DB, TypInfo, QuickRpt, rpColnBar,
rpIntEdit, rpTextCtrls;

type
TrpDataFieldProperty = class(TStringProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValues(Proc: TGetStrProc); override;
end;

TrpTextProperty = class(TStringProperty)
public
function GetAttributes: TPropertyAttributes; override;
end;

TrpIntegerProperty = class(TIntegerProperty)
private
FIntegerEditor: TrpIntegerEditor;
procedure IntegerEditorChange(Sender: TObject);
public
constructor Create(const ADesigner: {$IFDEF VER140}IDesigner{$ELSE}IFormDesigner{$ENDIF}; APropCount: Integer); override;
destructor Destroy; override;
function GetAttributes: TPropertyAttributes; override;
procedure Edit; override;
end;

TrpColumnBarEditor = class(TComponentEditor)
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;

procedure Register;

implementation

function TrpDataFieldProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paValueList, paMultiSelect];
end;

procedure TrpDataFieldProperty.GetValues(Proc: TGetStrProc);
var
I: Integer;
Values: TStringList;
DataSet: TDataSet;
begin
Values := TStringList.Create;
try
DataSet := GetObjectProp(GetComponent(0), 'DataSet') as TDataSet;
if Assigned(DataSet) then DataSet.GetFieldNames(Values);
for I := 0 to Values.Count - 1 do Proc(Values);
finally
Values.Free;
end;
end;

function TrpTextProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes;
Include(Result, paAutoUpdate);
end;

constructor TrpIntegerProperty.Create(const ADesigner: {$IFDEF VER140}IDesigner
{$ELSE}IFormDesigner{$ENDIF}; APropCount: Integer);
begin
inherited;
FIntegerEditor := nil;
end;

destructor TrpIntegerProperty.Destroy;
begin
if Assigned(FIntegerEditor) then FIntegerEditor.Free;
inherited;
end;

procedure TrpIntegerProperty.IntegerEditorChange(Sender: TObject);
begin
SetOrdValue(FIntegerEditor.IntValue);
end;

function TrpIntegerProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes;
Include(Result, paDialog);
end;

procedure TrpIntegerProperty.Edit;
begin
if not Assigned(FIntegerEditor) then
FIntegerEditor := TrpIntegerEditor.Create(Application);
with FIntegerEditor do
begin
IntValue := GetOrdValue;
OnChange := IntegerEditorChange;
Show;
end;
end;

procedure TrpColumnBarEditor.ExecuteVerb(Index: Integer);
var
ColumnBar: TrpColumnBar;
Report: TQuickRep;
begin
ColumnBar := TrpColumnBar(Component);
case Index of
0: ShowCollectionEditor(Designer, ColumnBar, ColumnBar.Columns, 'Columns');
1: { No Action };
2:
if MessageDlg('Do you remove all columns?', mtConfirmation, [mbOk, mbCancel], 0) = mrOk then
begin
ColumnBar.Columns.Clear;
Designer.Modified;
end;
3: { No Action };
4, 5:
if (ColumnBar.ParentReport is TQuickRep) and
(MessageDlg('All columns will be removed before loading, Continue?', mtConfirmation, [mbOk, mbCancel], 0) = mrOk) then
begin
Report := TQuickRep(ColumnBar.ParentReport);
case Index of
4: ColumnBar.Columns.LoadFromDataSet(Report.DataSet, True);
5: ColumnBar.Columns.LoadFromDataSet(Report.DataSet);
end;
Designer.Modified;
end;
end;
end;

function TrpColumnBarEditor.GetVerb(Index: Integer): string;
begin
case Index of
0: Result := '&Edit Columns...';
1: Result := '-';
2: Result := '&Remove all Columns...';
3: Result := '-';
4: Result := 'Load Field &Names...';
5: Result := 'Load Field &Values...';
end;
end;

function TrpColumnBarEditor.GetVerbCount: Integer;
begin
Result := 6;
end;

procedure Register;
begin
// TrpColumnBar ////////////////////////////////////////////////////////////////
RegisterComponents('Report Part', [TrpColumnBar]);
RegisterPropertyEditor(TypeInfo(string), TrpColumn, 'DataField', TrpDataFieldProperty);
RegisterPropertyEditor(TypeInfo(string), TrpColumn, 'FormatText', TrpTextProperty);
RegisterPropertyEditor(TypeInfo(string), TrpColumn, 'Text', TrpTextProperty);
RegisterPropertyEditor(TypeInfo(string), TrpColumnDiagonal, 'TextFirst', TrpTextProperty);
RegisterPropertyEditor(TypeInfo(string), TrpColumnDiagonal, 'TextSecond', TrpTextProperty);
RegisterPropertyEditor(TypeInfo(string), TrpColumnDiagonal, 'TextThird', TrpTextProperty);
RegisterPropertyEditor(TypeInfo(Integer), TrpColumn, 'Width', TrpIntegerProperty);
RegisterPropertyEditor(TypeInfo(Integer), TrpColumn, 'Height', TrpIntegerProperty);
RegisterPropertyEditor(TypeInfo(Integer), TrpColumn, 'ChildHeight', TrpIntegerProperty);
RegisterComponentEditor(TrpColumnBar, TrpColumnBarEditor);

// TrpText /////////////////////////////////////////////////////////////////////
RegisterComponents('Report Part', [TrpText]);
RegisterPropertyEditor(TypeInfo(string), TrpText, 'Text', TrpTextProperty);

// TrpDBText ///////////////////////////////////////////////////////////////////
RegisterComponents('Report Part', [TrpDBText]);
RegisterPropertyEditor(TypeInfo(string), TrpDBText, 'DataField', TrpDataFieldProperty);
RegisterPropertyEditor(TypeInfo(string), TrpDBText, 'FormatText', TrpTextProperty);

// TrpReportInfo ///////////////////////////////////////////////////////////////
RegisterComponents('Report Part', [TrpReportInfo]);
RegisterPropertyEditor(TypeInfo(string), TrpReportInfo, 'FormatText', TrpTextProperty);
end;

end.
 
是位热心的FW呵，请问哪个版的呀？
 
当然是最新的了。
 
现在有了更强的版本了，还增加了7个有用的组件，准备发布！！！
 
我已经快要晕倒了，提供一下下载好吗？
 
请到www.playicq.com下载最新版。
 
Report Part Components 2.2 现已发布（附源码，包含例子）
 
大家请到：www.playicq.com下载，我以后都在这个站点发布。
 
请问：可以：解决：在用户使用时，动态改变：QR报表的列宽，
以及：自定义纸张问题么？
 
接受答案了.
 
您必须登录或注册才可回复。

Similar threads

S
[原]UNIGUI中控件类名的变化
回复
0
查看
906
SUNSTONE的Delphi笔记
S
S
[原]UNIGUI中控件类名的变化
回复
0
查看
884
SUNSTONE的Delphi笔记
S
I
图像旋转控件
回复
0
查看
638
import
I
I
一个超级连接控件
回复
0
查看
539
import
I
I
Excel
回复
0
查看
559
import
I
后退
顶部