能畫斜線的QuickReport元件

bestlong

1. unit QRLine;
   
2. 
   
3. interface
   
4. 
   
5. uses
   
6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   
7.   QuickRpt;
   
8. 
   
9. type
   
10.   TQRLineStyle = (QRLineH, QRLineV, QRLineC);
    
11. 
    
12.   TQRLine = class(TQRPrintable)
    
13.   private
    
14.     FPen: TPen;
    
15.     FLineStyle: TQRLineStyle;
    
16.     procedure setPen(value: TPen);
    
17.     procedure setLineStyle(value: TQRLineStyle);
    
18.     procedure onPenChanged(Sendoer: TObject);
    
19.   protected
    
20.     { Protected declarations }
    
21.   public
    
22.     constructor Create(AOwner: TComponent); override;
    
23.     destructor Destroy; override;
    
24. 
    
25.     procedure Paint; override;
    
26.     procedure Print(OfsX, OfsY : integer); override;
    
27.   published
    
28.     property Pen: TPen read FPen write setPen;
    
29.     property LineStyle: TQRLineStyle read FLineStyle write setLineStyle;
    
30.   end;
    
31. 
    
32. procedure Register;
    
33. 
    
34. implementation
    
35. 
    
36. constructor TQRLine.Create(AOwner: TComponent);
    
37. begin
    
38.   inherited Create(AOwner);
    
39. 
    
40.   ControlStyle := ControlStyle - [csOpaque];
    
41.   FPen := TPen.Create;
    
42.   FPen.OnChange := onPenChanged;
    
43.   width := 100;
    
44.   height := 100;
    
45. end;
    
46. 
    
47. destructor TQRLine.Destroy;
    
48. begin
    
49.   FPen.Free;
    
50.   inherited Destroy;
    
51. end;
    
52. 
    
53. procedure TQRLine.SetPen(Value: TPen);
    
54. begin
    
55.   FPen.Assign(value);
    
56.   Invalidate;
    
57. end;
    
58. 
    
59. procedure TQRLine.setLineStyle(value: TQRLineStyle);
    
60. begin
    
61.   if FLineStyle <> value then
    
62.   begin
    
63.     FLineStyle := value;
    
64.     Invalidate;
    
65.   end;
    
66. end;
    
67. 
    
68. procedure TQRLine.onPenChanged(Sendoer: TObject);
    
69. begin
    
70.   Invalidate;
    
71. end;
    
72. 
    
73. procedure TQRLine.Paint;
    
74. var
    
75.   calDiff: integer;
    
76. begin
    
77.   with Canvas do
    
78.   begin
    
79.     Pen := FPen;
    
80.     calDiff := Pen.Width div 2;
    
81.     MoveTo(calDiff,calDiff);
    
82.     case LineStyle of
    
83.       QRLineH: LineTo(width, 0 + calDiff);
    
84.       QRLineV: LineTo(calDiff, Height);
    
85.       QRLineC: LineTo(width, Height);
    
86.     end;
    
87.   end;
    
88. end;
    
89. 
    
90. procedure TQRLine.Print(OfsX, OfsY : integer);
    
91. var
    
92.   CalcLeft,
    
93.   CalcTop,
    
94.   CalcRight,
    
95.   CalcBottom: integer;
    
96. begin
    
97.   with ParentReport.QRPrinter do
    
98.   begin
    
99.     Canvas.Pen := FPen;
    
100.     CalcLeft   := XPos(OfsX + Size.Left);
     
101.     CalcTop    := YPos(OfsY + Size.Top);
     
102.     CalcRight  := XPos(OfsX + Size.Left + Size.Width);
     
103.     CalcBottom := YPos(OfsY + Size.Top + Size.Height);
     
104.     with Canvas do
     
105.     begin
     
106.       MoveTo(CalcLeft,CalcTop);
     
107.       case LineStyle of
     
108.         QRLineH: LineTo(CalcRight, CalcTop);
     
109.         QRLineV: LineTo(CalcLeft, CalcBottom);
     
110.         QRLineC: LineTo(CalcRight, CalcBottom);
     
111.       end;
     
112.     end;
     
113.   end;
     
114. end;
     
115. 
     
116. procedure Register;
     
117. begin
     
118.   RegisterComponents(‘QReport‘, [TQRLine]);
     
119. end;
     
120. 
     
121. end.

複製代碼

參考來源 http://www.8888i.net/dispQAInfo.php?id=567