|
|
|
|
Компонент для отрисовки линий
Вот компонент, инкапсулирующий функции рисования линий. Он может рисовать горизонтальные, вертикальные и диагональные линии. Вы можете добавить необходимые вам события в секцию *published*.
|
unit Lines; {от Bill Murto, CIS 73730,2505}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms;
type
TLineOrigin = (loTopLeft, loTopRight);
TLine = class(TGraphicControl)
private
{ Private declarations }
fOrigin: TLineOrigin;
fPen: TPen;
procedure SetOrigin(Value: TLineOrigin);
procedure SetPen(Value: TPen);
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Origin: TLineOrigin read fOrigin write SetOrigin default
loTopLeft;
property Pen: TPen read fPen write SetPen;
property Height default 33;
property Width default 33;
procedure StyleChanged(Sender: TObject);
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TLine]);
end;
procedure TLine.SetOrigin(Value: TLineOrigin);
begin
if fOrigin <> Value then
begin
fOrigin := Value;
Invalidate;
end;
end;
procedure TLine.SetPen(Value: TPen);
begin
fPen.Assign(Value);
end;
procedure TLine.StyleChanged(Sender: TObject);
begin
Invalidate;
end;
constructor TLine.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := 33;
Width := 33;
fPen := TPen.Create;
fPen.OnChange := StyleChanged;
if csOpaque in ControlStyle then
ControlStyle := ControlStyle - [csOpaque];
end;
procedure TLine.Paint;
begin
with Canvas do
begin
Pen := fPen;
if (Width <= Pen.Width) or (Height <= Pen.Width) then
begin
if Width <= Pen.Width then begin MoveTo(0, 0); LineTo(0, Height); end;
if Height <= Pen.Width then begin MoveTo(0, 0); LineTo(Width, 0); end;
end
else
case fOrigin of
loTopLeft: begin MoveTo(0, 0); LineTo(Width, Height); end;
loTopRight: begin MoveTo(Width, 0); LineTo(0, Height); end;
end;
end;
end;
destructor TLine.Destroy;
begin
fPen.Free;
inherited Destroy;
end;
end.
|
- William E Murto [000784]
|
|
|
|
|