TQRLine - 在Quick Rep下划斜线的构件(0分)

用来在Quick Report下划斜线的构件，代码比较短，就全文贴上了。
97年作品，所以没有文档。
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 Canvasdo
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.QRPrinterdo
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 Canvasdo
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.

Hehe, 正好拿来用。

这个东东好！

偶也正好要用，多谢了

谢谢！我也Copy一份!

踏破铁鞋无觅处 得来全不费功夫
谢了。

要是有一个象FRONTPAGE中的那样的表格控件就更好了。

接受答案了.