unit Qrline;
interface
uses
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;
implementation
constructor 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.