www.pudn.com > Dephi报表中画线控件.rar > Qrline.pas

unit Qrline; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
       Quickrpt;  
type 
  TQRLineStyle=(QRLineH,QRLineV,QRLineC); 
  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); 
    case LineStyle of 
     QRLineH:LineTo(width,0+calDiff); 
     QRLineV:LineTo(calDiff,Height); 
     QRLineC:LineTo(width,Height); 
    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.