| 。
本控件在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.
|
|
