然而,在设计中国式报表时,笔叻⑾衷赒uickReport中设计列与列之间的竖线和斜线比较困难;虽然QuickReport提供了TQShape控件,使用该控件可以画出列与列之间的竖线,但如果用户不能正确地调整TQShape实例的高度,输出报表中的竖线不是不连续就是超长,另外如果我们调整了某个Band的高度,我们将不得不调整该Band下的所有TQShape实例的高度;至于斜线,QuickReport报表组件根本就没有提供这一功能。
笔者认真查找了有关的资料,成功地解决了以上问题,希望能对大家有所帮助。
解决思路
以TQShape为父类,建立新的控件,新控件可以画竖线、斜线和反斜线。
重载TQShape 类的Paint方法,这样在设计阶段可以非常直观地画坚线、斜线和反斜线。用户可以在设计阶段选择线的类型,如果选择直线,控件自动将其高度调整为所属Band的高度,用户可以调整其横向位置但不能调整其高度;如果选择斜线,用户可以根据需要调整斜线的长度和倾角。重载TQShape 类的Print方法,这样可以在运行阶段输出直线和斜线。
说明:该控件只能画直线和斜线,如果读者需要画矩形和圆,可以使用TQShape控件来实现。
控件设计步骤
步骤1.使用Delphi提供的控件向导,选择TQShape为父类,建立新类TMyQRShape,并选择适当的包(Package),最后生成单元文件。
步骤2.在生成的单元文件中,增加枚举类型。
TLines = ( None,TopBottom,BottomTop ) None、TopBottom、BottomTop三种取值,分别代表直线、斜线 \ 和反斜线 /。
步骤3.在新类TMyQRShape 中增加private 成员 FLineType:TLines ,增加published属性 LineType:TLines Read
FLineType Write SetFLineType。
步骤4.建立过程SetFLineType。
procedure TMyQRShape.SetFLineType(value:TLines); begin if value<>FLineType then |
begin FLineType:=value Invalidate end end |
步骤5.重载Paint方法。[page]
procedure TMyQRShape.Paint begin case LineType of BottomTop: begin Canvas.MoveTo(0,Height) Canvas.LineTo(width,0 ) end TopBottom: begin Canvas.MoveTo(0,0) Canvas.LineTo(width,Height ) end None: begin Height := Parent.Height Top:=0 Width:=4 |
Shape:=qrsVertLine Inherited Paint end end end |
步骤6.重载Print方法。[page]
procedure TMyQRShape.Print(OfsX,OfsY : Integer); begin with QRPrinter do begin case LineType of BottomTop: begin Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)+Height) Canvas.LineTo(XPos(OfsX + Size.Left)+width,YPos(OfsY + Size.Top) ) end TopBottom: begin Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)) Canvas.LineTo(XPos(OfsX + Size.Left)+Width,YPos(OfsY + Size.Top)+Height ) end None: Inherited Print(OfsX,OfsY ) end end end; |
步骤7.保存并安装TMyQRShape控件。
本控件在Delphi40下调试、安装,并成功地应用于某数据库管理系统的开发中。该控件的完整代码如下:
源程序:[page]
unit MyQRShape; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, QuickRpt, Qrctrls; type TLines = ( None,TopBottom,BottomTop ) TMyQRShape = class(TQRShape) private FLineType:TLines procedure SetFLineType(value:TLines) protected procedure Print(OfsX, OfsY : integer); override; procedure Paint Override public published property LineType:TLines Read FLineType Write SetFLineType end; |
[page]
procedure Register; implementation procedure TMyQRShape.SetFLineType(value:TLines); begin if value<>FLineType then begin FLineType:=value Invalidate end end procedure TMyQRShape.Paint begin case LineType of BottomTop: begin Canvas.MoveTo(0,Height) Canvas.LineTo(width,0 ) end TopBottom: begin Canvas.MoveTo(0,0) Canvas.LineTo(width,Height ) end |
[page]
None: begin Height := Parent.Height Top:=0 Width:=4 Shape:=qrsVertLine Inherited Paint end end end procedure TMyQRShape.Print(OfsX,OfsY : Integer); begin with QRPrinter do begin case LineType of BottomTop: begin Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)+Height) Canvas.LineTo(XPos(OfsX + Size.Left)+width,YPos(OfsY + Size.Top) ) end TopBottom: begin Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)) Canvas.LineTo(XPos(OfsX + Size.Left)+Width,YPos(OfsY + Size.Top)+Height ) end None: Inherited Print(OfsX,OfsY ) end end end; procedure Register; begin RegisterComponents(‘QReport', [TMyQRShape]); end; end. |