可能需要自己画线吧: 程序参考: unit Qrline;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Quickrpt; type TQRLineStyle=(QRLineH,QRLineV,QRLineC,QRLineCR); TQRLine = class(TQRPrintable) private { Private declarations } FPen:TPen; FLineStyle:TQRLineStyle; protected { Protected declarations } procedure setPen(value:TPen); procedure setLineStyle(value:TQRLineStyle); procedure onPenChanged(Sender:TObject); public { Public declarations } constructor Create(AOwner:TComponent);override; destructor Destroy;override; procedure Paint;override; procedure Print(OfsX,OfsY:integer);override; published { Published declarations } property Pen:TPen read FPen write setPen; property LineStyle:TQRLineStyle read FLineStyle write setLineStyle; end;procedure Register;implementationconstructor TQRLine.Create(AOwner:TComponent); begin inherited Create(AOwner); ControlStyle:=ControlStyle-[csOpaque]; FPen:=Tpen.Create ; FPen.OnChange:=onPenChanged; width:=100; height:=100; end;destructor TQRLine.Destroy; begin FPen.Free; inherited Destroy; end;procedure TQRLine.setPen(value:TPen); begin FPen.Assign(value); invalidate; end;procedure TQRLine.setLineStyle(value:TQRLineStyle); begin if FLineStyle<>value then begin FLineStyle:=value; invalidate; end; end;procedure TQRLine.onPenChanged(Sender:TObject); begin invalidate; end;procedure TQRLine.Paint; var calDiff:integer; begin with Canvas do begin Pen:=FPen; calDiff:=Pen.Width div 2; MoveTo(calDiff,calDiff); if LineStyle=QRLineCR then begin MoveTo(calDiff,Height- calDiff); end; case LineStyle of QRLineH:LineTo(width,0+calDiff); QRLineV:LineTo(calDiff,Height); QRLineC:LineTo(width,Height); QRLineCR:LineTo(width,0); end; end; end;procedure TQRLine.Print(OfsX,OfsY:integer); var CalcLeft,CalcTop,CalcRight,CalcBottom:integer; begin with ParentReport.QRPrinter do begin Canvas.Pen:=FPen; CalcLeft:=XPos(OfsX+Size.Left); CalcTop:=YPos(OfsY+Size.Top); CalcRight:=XPos(OfsX+Size.Left+Size.Width); CalcBottom:=YPos(OfsY+Size.Top+Size.Height); with Canvas do begin MoveTo(CalcLeft,CalcTop); case LineStyle of QRLineH:LineTo(CalcRight,CalcTop); QRLineV:LineTo(CalcLeft,CalcBottom); QRLineC:LineTo(CalcRight,CalcBottom); end; end; end; end;procedure Register; begin RegisterComponents('Qreport', [TQRLine]); end;end.
程序参考:
unit Qrline;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Quickrpt;
type
TQRLineStyle=(QRLineH,QRLineV,QRLineC,QRLineCR);
TQRLine = class(TQRPrintable)
private
{ Private declarations }
FPen:TPen;
FLineStyle:TQRLineStyle;
protected
{ Protected declarations }
procedure setPen(value:TPen);
procedure setLineStyle(value:TQRLineStyle);
procedure onPenChanged(Sender:TObject);
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
procedure Paint;override;
procedure Print(OfsX,OfsY:integer);override;
published
{ Published declarations }
property Pen:TPen read FPen write setPen;
property LineStyle:TQRLineStyle read FLineStyle write setLineStyle;
end;procedure Register;implementationconstructor TQRLine.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
ControlStyle:=ControlStyle-[csOpaque];
FPen:=Tpen.Create ;
FPen.OnChange:=onPenChanged;
width:=100;
height:=100;
end;destructor TQRLine.Destroy;
begin
FPen.Free;
inherited Destroy;
end;procedure TQRLine.setPen(value:TPen);
begin
FPen.Assign(value);
invalidate;
end;procedure TQRLine.setLineStyle(value:TQRLineStyle);
begin
if FLineStyle<>value then
begin
FLineStyle:=value;
invalidate;
end;
end;procedure TQRLine.onPenChanged(Sender:TObject);
begin
invalidate;
end;procedure TQRLine.Paint;
var
calDiff:integer;
begin
with Canvas do
begin
Pen:=FPen;
calDiff:=Pen.Width div 2;
MoveTo(calDiff,calDiff);
if LineStyle=QRLineCR then begin
MoveTo(calDiff,Height- calDiff);
end;
case LineStyle of
QRLineH:LineTo(width,0+calDiff);
QRLineV:LineTo(calDiff,Height);
QRLineC:LineTo(width,Height);
QRLineCR:LineTo(width,0);
end;
end;
end;procedure TQRLine.Print(OfsX,OfsY:integer);
var
CalcLeft,CalcTop,CalcRight,CalcBottom:integer;
begin
with ParentReport.QRPrinter do
begin
Canvas.Pen:=FPen;
CalcLeft:=XPos(OfsX+Size.Left);
CalcTop:=YPos(OfsY+Size.Top);
CalcRight:=XPos(OfsX+Size.Left+Size.Width);
CalcBottom:=YPos(OfsY+Size.Top+Size.Height);
with Canvas do
begin
MoveTo(CalcLeft,CalcTop);
case LineStyle of
QRLineH:LineTo(CalcRight,CalcTop);
QRLineV:LineTo(CalcLeft,CalcBottom);
QRLineC:LineTo(CalcRight,CalcBottom);
end;
end;
end;
end;procedure Register;
begin
RegisterComponents('Qreport', [TQRLine]);
end;end.