QuickReport绘制中国式报表

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.