QuickReport FAQ 很好的关于QuickReport的资料,很详细的.
http://www.qusoft.com/
http://www.qusoft.com/
解决方案 »
- {$R *.RES}起什么作用? 如何看.res文件的内容
- QQ的代理通信机制
- 在Delphi中如何操作网页
- [提问]Delphi调用wordapplication.Documents.Open时奇怪的现象
- 怎么样识别用户按下“CTRL”+“V”键,并触发事件发生
- 关于第三方控件的使用,有两个问题
- 谁知道哪里有WindowMediaPlayer组件编程的例程?
- 类似QQ面板、Outlook面板的控件,是我自己编写的。现在先贴出部分文档,在我整理完之后会发到网上希望大家给与支持。
- IME 输入法的imeMode如何保存到注册表?
- 如何让DBGRID中的某列得不到焦点?
- 怎么从字段名判断这个字段是来自于哪个表?
- SOS 我的SQL SERVER 7.0 备份不能恢复,提示信息见里面!
http://www.qusoft.com/
中国式的报表很变态,各种各样的框线,不同的间距,
斜线什么什么的很头疼的说,以前曾经看过一个医院的报表
各种无规则线条遍布简直象城市规划图,呵呵
而目前好像也没有什么特别方便的画中国式报表的控件
好一点的如ReportBuilder,FastReport, AcerReport等等
大多属于有版权限制而且使用也不是很容易,
而对此问题偶的解决方法无非是两种,
一是在word/excel里面生成报表模板,
然后程序通过VBA调用之,生成报表,预览、打印
这样做出来的报表非常PP,也很灵活,但是需要对方有OFFICE
开发者对OFFICE VBA也必须有一定认识,中文版的OFFICE
都带有详细的VBA编程说明,有兴趣在这方面下功夫的朋友
可以研究一下,这里就不再罗嗦了……
另外一种解决方法也是我比较喜欢的方法是编写专门的控件
因为实在没有时间精力开发一套通用控件,也不知道是否真的能
开发出这样一套通用控件,因此偶一般是针对项目的要求
编写定制报表控件,其实只要知道了大概的步骤,
编写这样一个控件非常简单,而且方便
下面就以一个简单的报表的例子简述一下
(因为删去一些适应特殊要求的代码,控件功能比较简单
不过刚刚适合做演示用 :)
首先,一个QuickReport控件必须继承自TQRPrintable类
比如TQRTable = class(TQRPrintable)
其次,有两个方法必须重载,如
procedure Paint; override;
procedure Print(OfsX, OfsY : Integer); override;
Paint负责设计时显示控件,而Print负责预览、打印时将
报表画在打印机上,打印机被QuickReport控件封装在一个
QRPrinter对象中,通过QRPrinter.Canvas可以直接在打印机上画
出你的报表:) 因此你就当作是在一块白布上画图好了,呵呵
另外在控件编写中注意打印机的Font, Pen, Brush必须自行保存设置
因为你的报表上不只你一个控件,其他控件会修改这些对象
最后还有一些需要注意的,如显示和打印时的画表代码可以共用,
建议将之独立出来,但要注意打印时偏移的处理箜
另外中国式报表经常出现列的特殊定义,建议用一个TCollection
的子类来处理,这样可以实现设计时手工调整,具体实现见下面示例
下面是一个简单的例子,因为原来编写时时间赶得比较紧
代码没有注释,风格也不是很好,大家不要学偶,呵呵
虽然删去了一些功能,但是基本上还是一个完整的
贴出来给希望在这方面做工作的朋友做个参考 :)
其实大概看一下就会发现很简单的说,QuickReport也有源代码在网上
可以下载到,记得cn-ftp.dhs.org以前好像有……
想到哪里写到哪里,没有什么条理,请见谅,有什么不清楚的
或者偶有什么错误需要指出的请re此文 :)
unit QRTable;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
QuickRpt;
type
TQRTableColumn = class(TCollectionItem)
private
FAlignment: TAlignment;
FCaption: string;
FMaxWidth,
FMinWidth,
FWidth,
FTag: Integer;
FSubColumns: TStringList;
procedure SetAlignment(Value: TAlignment);
procedure SetCaption(const Value: string);
procedure SetMaxWidth(Value: Integer);
procedure SetMinWidth(Value: Integer);
procedure SetWidth(Value: Integer);
procedure SetSubColumns(Value: TStringList);
function GetColCount: Integer;
protected
function GetDisplayName: string; override;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure DrawColumn(Canvas: TCanvas; const R: TRect);
property ColCount: Integer read GetColCount;
published
property Alignment: TAlignment read FAlignment write SetAlignment defaul
t taCenter;
property Caption: string read FCaption write SetCaption;
property MaxWidth: Integer read FMaxWidth write SetMaxWidth default 0;
property MinWidth: Integer read FMinWidth write SetMinWidth default 0;
property Width: Integer read FWidth write SetWidth default 64;
property Tag: Integer read FTag write FTag default 0;
property SubColumns: TStringList read FSubColumns write SetSubColumns;
end;
TQRTable = class;
TQRTableColumns = class(TCollection)
private
FOwner: TQRTable;
function GetItem(Index: Integer): TQRTableColumn;
procedure SetItem(Index: Integer; Value: TQRTableColumn);
protected
function GetOwner: TPersistent; override;
procedure Update(Item: TCollectionItem); override;
public
constructor Create(AOwner: TQRTable);
function Add: TQRTableColumn;
property Owner: TQRTable read FOwner;
property Items[Index: Integer]: TQRTableColumn read GetItem write SetIte
m; default;
end;
TQRTableGetColumnDataEvent = procedure (Sender: TObject; ACol, ARow: Integ
er; Data: TStringList) of object;
TQRTable = class(TQRPrintable)
private
FFont: TFont;
FDrawFrame: Boolean;
FGridLineWidth,
FFrameLineWidth: Integer;
FFixedColWidth,
FFixedRowHeight: Integer;
FDefaultColWidth,
FDefaultRowHeight: Integer;
FAutoColWidth,
FAutoRowHeight: Boolean;
FColumns: TQRTableColumns;
FFixedRows: TStringList;
FOnGetColumnData: TQRTableGetColumnDataEvent;
procedure SetFont(Value: TFont);
procedure SetDrawFrame(Value: Boolean);
procedure SetGridLineWidth(Value: Integer);
procedure SetFrameLineWidth(Value: Integer);
procedure SetFixedRows(Value: TStringList);
procedure SetFixedColWidth(Value: Integer);
procedure SetFixedRowHeight(Value: Integer);
procedure SetDefaultColWidth(Value: Integer);
procedure SetDefaultRowHeight(Value: Integer);
procedure SetAutoColWidth(Value: Boolean);
procedure SetAutoRowHeight(Value: Boolean);
protected
procedure Paint; override;
procedure Print(OfsX, OfsY : Integer); override;
procedure ContentChange(Sender: TObject);
procedure DrawFrames(Canvas: TCanvas; OfsX, OfsY: Integer);
procedure DrawCorner(Canvas: TCanvas; OfsX, OfsY: Integer);
procedure DrawFixed(Canvas: TCanvas; OfsX, OfsY: Integer);
procedure DrawTable(Canvas: TCanvas; OfsX, OfsY: Integer);
procedure DrawContent(Canvas: TCanvas; OfsX, OfsY: Integer);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function ColWidth(ACol: Integer): Integer;
function RowHeight(ARow: Integer): Integer;
function CellRect(ACol, ARow: Integer): TRect;
published
property Font: TFont read FFont write SetFont;
property DrawFrame: Boolean read FDrawFrame write SetDrawFrame default T
rue;
property GridLineWidth: Integer read FGridLineWidth write SetGridLineWid
th default 1;
property FrameLineWidth: Integer read FFrameLineWidth write SetFrameLine
Width default 2;
property AutoColWidth: Boolean read FAutoColWidth write SetAutoColWidth
default True;
property AutoRowHeight: Boolean read FAutoRowHeight write SetAutoRowHeig
ht default True;
property DefaultColWidth: Integer read FDefaultColWidth write SetDefault
ColWidth default 64;
property DefaultRowHeight: Integer read FDefaultRowHeight write SetDefau
ltRowHeight default 24;
property FixedRows: TStringList read FFixedRows write SetFixedRows;
property FixedColWidth: Integer read FFixedColWidth write SetFixedColWid
th default 64;
property FixedRowHeight: Integer read FFixedRowHeight write SetFixedRowH
eight default 24;
property Columns: TQRTableColumns read FColumns write FColumns;
property OnGetColumnData: TQRTableGetColumnDataEvent read FOnGetColumnDa
ta write FOnGetColumnData;
property Alignment;
property AlignToBand;
end;
procedure Register;
implementation
function OffsetRect(R: TRect; OfsX, OfsY: Integer): TRect;
begin
with Result do
begin
Left := OfsX + R.Left;
Right := OfsX + R.Right;
Top := OfsY + R.Top;
Bottom := OfsY + R.Bottom;
end;
end;
procedure DrawText(Canvas: TCanvas; R: TRect; const Text: string; Align: TAl
ignment = taCenter);
var
X, Y: Integer;
Str: string;
begin
Canvas.Font.Color := clBlack;
Str := Trim(Text);
case Align of
taLeftJustify:
X := R.Left;
taRightJustify:
X := R.Left + ((R.Right - R.Left) - Canvas.TextWidth(Str));
taCenter:
X := R.Left + ((R.Right - R.Left) - Canvas.TextWidth(Str)) div 2;
else
X := R.Left;
end;
Y := R.Top + ((R.Bottom - R.Top) - Canvas.TextHeight(Str)) div 2;
Canvas.TextOut(X, Y, Str);
end;
{ TQRTableColumn }
constructor TQRTableColumn.Create(Collection: TCollection);
var
Table: TQRTable;
begin
inherited Create(Collection);
Table := (Collection as TQRTableColumns).Owner as TQRTable;
FAlignment := taCenter;
FCaption := '';
FMaxWidth := 0;
FMinWidth := 0;
FWidth := Table.FixedColWidth;
FTag := 0;
FSubColumns:= TStringList.Create;
end;
destructor TQRTableColumn.Destroy;
begin
FSubColumns.Free;
inherited Destroy;
end;
procedure TQRTableColumn.Assign(Source: TPersistent);
var
Column: TQRTableColumn;
begin
if Source is TQRTableColumn then
begin
Column := Source as TQRTableColumn;
FAlignment := Column.Alignment;
FCaption := Column.Caption;
FMaxWidth := Column.MaxWidth;
FMinWidth := Column.MinWidth;
FWidth := Column.Width;
FTag := Column.Tag;
FSubColumns.Assign(Column.SubColumns);
end
else
inherited Assign(Source);
end;
function TQRTableColumn.GetDisplayName: string;
begin
if FCaption <> '' then
Result := FCaption
else
Result := ClassName;
end;
procedure TQRTableColumn.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Changed(False);
end;
end;
procedure TQRTableColumn.SetCaption(const Value: string);
begin
if FCaption <> Value then
begin
FCaption := Value;
Changed(False);
end;
end;
procedure TQRTableColumn.SetMaxWidth(Value: Integer);
begin
if FMaxWidth <> Value then
begin
FMaxWidth := Value;
if FMaxWidth < 0 then
FMaxWidth := 0;
if FMaxWidth < FMinWidth then
FMaxWidth := FMinWidth;
if FWidth > FMaxWidth then
FWidth := FMaxWidth;
Changed(False);
end;
end;
procedure TQRTableColumn.SetMinWidth(Value: Integer);
begin
if FMinWidth <> Value then
begin
FMinWidth := Value;
if FMinWidth < 0 then
FMinWidth := 0;
if FMinWidth > FMaxWidth then
FMinWidth := FMaxWidth;
if FWidth < FMinWidth then
FWidth := FMinWidth;
Changed(False);
end;
end;
begin
if FWidth <> Value then
begin
if (FMinWidth > 0) and (Value < MinWidth) then
FWidth := MinWidth
else if (FMaxWidth > 0) and (Value > MaxWidth) then
FWidth := MaxWidth
else
FWidth := Value;
Changed(False);
end;
end;
procedure TQRTableColumn.SetSubColumns(Value: TStringList);
begin
FSubColumns.Assign(Value);
Changed(False);
end;
function TQRTableColumn.GetColCount: Integer;
begin
if FSubColumns.Count > 0 then
Result := FSubColumns.Count
else
Result := 1;
end;
procedure TQRTableColumn.DrawColumn(Canvas: TCanvas; const R: TRect);
var
I, SubColLeft, SubColWidth: Integer;
Center: TPoint;
begin
if FSubColumns.Count > 0 then
begin
Center.x := (R.Left + R.Right) div 2;
Center.y := (R.Top + R.Bottom) div 2;
Canvas.MoveTo(R.Left, Center.y);
Canvas.LineTo(R.Right, Center.y);
DrawText(Canvas, Rect(R.Left, R.Top, R.Right, Center.y), FCaption, FAlig
nment);
SubColWidth := Width div FSubColumns.Count;
for I:=0 to FSubColumns.Count-1 do
begin
SubColLeft := R.Left + SubColWidth * I;
if I <> 0 then
begin
Canvas.MoveTo(SubColLeft, (R.Top + R.Bottom) div 2);
Canvas.Lineto(SubColLeft, R.Bottom + TQRTableColumns(Collection).Own
er.Height - (R.Bottom - R.Top));
end;
DrawText(Canvas, Rect(SubColLeft, (R.Top + R.Bottom) div 2,
SubColLeft + SubColWidth, R.Bottom), SubColumns[
I], FAlignment);
end;
end
else
DrawText(Canvas, R, FCaption, FAlignment);
end;
{ TQRTableColumns }
constructor TQRTableColumns.Create(AOwner: TQRTable);
begin
inherited Create(TQRTableColumn);
FOwner := AOwner;
end;
function TQRTableColumns.GetItem(Index: Integer): TQRTableColumn;
begin
Result := TQRTableColumn(inherited GetItem(Index));
end;
procedure TQRTableColumns.SetItem(Index: Integer; Value: TQRTableColumn);
begin
inherited SetItem(Index, Value);
end;
function TQRTableColumns.GetOwner: TPersistent;
begin
Result := FOwner;
end;
procedure TQRTableColumns.Update(Item: TCollectionItem);
begin
FOwner.Invalidate;
end;
function TQRTableColumns.Add: TQRTableColumn;
begin
Result := TQRTableColumn(inherited Add);
FOwner.Invalidate;
end;
{ TQRTable }
constructor TQRTable.Create(AOwner: TComponent);
var
ABand: TQRCustomBand;
begin
inherited Create(AOwner);
Height := 65;
if AOwner is TQRCustomBand then
begin
ABand := AOwner as TQRCustomBand;
Width := ABand.Width;
Left := 0;
end
else
Width := 65;
FFont := TFont.Create;
FFont.OnChange := ContentChange;
FDrawFrame := True;
FGridLineWidth := 1;
FFrameLineWidth := 2;
FFixedColWidth := 64;
FFixedRowHeight := 24;
FFixedRows := TStringList.Create;
FFixedRows.OnChange := ContentChange;
FDefaultColWidth := 64;
FDefaultRowHeight := 24;
FAutoColWidth := True;
FAutoRowHeight := True;
FColumns := TQRTableColumns.Create(Self);
end;
destructor TQRTable.Destroy;
begin
FFont.Free;
FFixedRows.Free;
FColumns.Free;
inherited Destroy;
end;
procedure TQRTable.ContentChange(Sender: TObject);
begin
Invalidate;
end;
function TQRTable.ColWidth(ACol: Integer): Integer;
begin
if ACol = 0 then
Result := FFixedColWidth
else if FAutoColWidth then
Result := (Width - FFixedColWidth) div (FColumns.Count - 1)
else
Result := FDefaultColWidth;
end;
function TQRTable.RowHeight(ARow: Integer): Integer;
begin
if ARow = 0 then
Result := FFixedRowHeight
else if FAutoRowHeight then
Result := (Height - FFixedRowHeight) div (FFixedRows.Count - 1)
else
Result := FDefaultRowHeight;
end;
function TQRTable.CellRect(ACol, ARow: Integer): TRect;
var
I: Integer;
begin
FillChar(Result, SizeOf(TRect), 0);
for I:=0 to ACol-1 do
Inc(Result.Left, ColWidth(I));
for I:=0 to ARow-1 do
Inc(Result.Top, RowHeight(I));
Result.Right := Result.Left + ColWidth(ACol);
Result.Bottom := Result.Top + RowHeight(ARow);
end;
procedure TQRTable.SetFont(Value: TFont);
begin
FFont.Assign(Value);
Invalidate;
end;
procedure TQRTable.SetDrawFrame(Value: Boolean);
begin
if FDrawFrame <> Value then
begin
FDrawFrame := Value;
Invalidate;
end;
end;
procedure TQRTable.SetGridLineWidth(Value: Integer);
begin
if FGridLineWidth <> Value then
begin
FGridLineWidth := Value;
Invalidate;
end;
end;
procedure TQRTable.SetFrameLineWidth(Value: Integer);
begin
if FFrameLineWidth <> Value then
begin
FFrameLineWidth := Value;
Invalidate;
end;
end;
procedure TQRTable.SetFixedRows(Value: TStringList);
begin
FFixedRows.Assign(Value);
Invalidate;
end;
procedure TQRTable.SetFixedColWidth(Value: Integer);
begin
if FFixedColWidth <> Value then
begin
FFixedColWidth := Value;
Invalidate;
end;
end;
[email protected]我有QR2.0的源码,帮助,FAQ,,,反正就是网上的那个,你要是有,你自己下,
要是没有,又 一时找不到,那么就给我发MAIL,同时给我分,