灯火互联
管理员
管理员
  • 注册日期2011-07-27
  • 发帖数41778
  • QQ
  • 火币41290枚
  • 粉丝1086
  • 关注100
  • 终身成就奖
  • 最爱沙发
  • 忠实会员
  • 灌水天才奖
  • 贴图大师奖
  • 原创先锋奖
  • 特殊贡献奖
  • 宣传大使奖
  • 优秀斑竹奖
  • 社区明星
阅读:4048回复:0

用Delphi制作中国式报表

楼主#
更多 发布于:2012-09-08 13:05

在数据库应用程序开发中,系统设计员、程序设计员需要考虑的一个重要问题是如何设计和输出报表,在delphi中我们可以采
用多种方案来解决这一问题。如运用OLE自动化技术将数据输出到MS-word、MS-Excel中等,但其中最直接、最本地化的还是使用
delphi3.0/40中的QuickReport报表组件。它是挪威QuSoft公司专门为delphi 编写的,使用QuickReport可以迅速设计出符合西
方人习惯用的报表。
    然而,在设计中国式报表时,笔者发现在QuickReport中设计列与列之间的竖线和斜线比较困难;虽然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方法。
    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方法。
    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下调试、安装,并成功地应用于某数据库管理系统的开发中。该控件的完整代码如下:
    源程序:
    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;
    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 ;
    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.

喜欢0 评分0
游客

返回顶部