Компонент для отрисовки линий
Компонент для отрисовки линий
Автор: William E Murto
Вот компонент, инкапсулирующий функции рисования линий. Он может рисовать
горизонтальные, вертикальные и диагональные линии. Вы можете добавить
необходимые вам события в секцию *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 .
Компонент для отрисовки линий, позволяющий рисовать горизонтальные, вертикальные и диагональные линии с возможностью изменения параметров рисования.
Комментарии и вопросы Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
:: Главная :: Компоненты и Графика ::