能畫斜線的QuickReport元件

bestlong 發表於 2010-8-25 09:18

[code]
unit QRLine;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  QuickRpt;

type
  TQRLineStyle = (QRLineH, QRLineV, QRLineC);

  TQRLine = class(TQRPrintable)
  private
FPen: TPen;
FLineStyle: TQRLineStyle;
procedure setPen(value: TPen);
procedure setLineStyle(value: TQRLineStyle);
procedure onPenChanged(Sendoer: TObject);
  protected
{ Protected declarations }
  public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

procedure Paint; override;
procedure Print(OfsX, OfsY : integer); override;
  published
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(Sendoer: 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.
[/code]參考來源 [url]http://www.8888i.net/dispQAInfo.php?id=567[/url]

頁: [1]

bestlong 怕失憶論壇's Archiver

能畫斜線的QuickReport元件