Советы по Delphi

доставка запчасти холодильников obmennik-uz.ru в Вашем городе

Компонент для отрисовки линий


Вот компонент, инкапсулирующий функции рисования линий. Он может рисовать горизонтальные, вертикальные и диагональные линии. Вы можете добавить необходимые вам события в секцию *published*.

unit Lines; {от Bill Murto, CIS 73730,2505}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms;
typeTLineOrigin = (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 defaultloTopLeft;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
;beginRegisterComponents('Samples', [TLine]);end;
procedure TLine.SetOrigin(Value: TLineOrigin);beginif fOrigin <> Value thenbeginfOrigin := Value;Invalidate;end;end;
procedure TLine.SetPen(Value: TPen);beginfPen.Assign(Value);end;
procedure TLine.StyleChanged(Sender: TObject);beginInvalidate;end;
constructor TLine.Create(AOwner: TComponent);begininherited Create(AOwner);Height := 33;Width := 33;fPen := TPen.Create;fPen.OnChange := StyleChanged;if csOpaque in ControlStyle thenControlStyle := ControlStyle - [csOpaque];end;
procedure TLine.Paint;beginwith Canvas dobeginPen := fPen;if (Width <= Pen.Width) or (Height <= Pen.Width) thenbeginif 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;endelsecase fOrigin ofloTopLeft: begin MoveTo(0, 0); LineTo(Width, Height); end;loTopRight: begin MoveTo(Width, 0); LineTo(0, Height); end;end;end;end;
destructor TLine.Destroy;beginfPen.Free;inherited Destroy;end;
end.

- William E Murto [000784]




Начало  Назад  Вперед



Книжный магазин