程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 用Delphi制作中國式報表

用Delphi制作中國式報表

編輯:Delphi
在數據庫應用程序開發中,系統設計員、程序設計員需要考慮的一個重要問題是如何設計和輸出報表,在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;
  
  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved