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; "inherited destroy;
Procedure tqrline.setpen (value: tpen); begin fpEN.Assign (value); invalidate;
Procedure tqrline.setLinesTyle (Value: tqrlinestyle); begin if flinesTyle <> value dam flines: = value; invalidate; end;
Procedure tqrline.onpenchanged (sender: TOBJECT); project;
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; 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 , CASE LINESTYLE OF QRLINEHH: LINETO (CALCRIGHT, CALCTOP); QRLINEV: LINETO (CalcRight, Calcbottom); QrLinec: Lineto (Calcright, Calcbottom); end; end; end; end; End;
Procedure Register; Begin RegisterComponents ('QReport', [TQRLINE]); END;
End.