Советы по Delphi

         

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


Вот компонент, инкапсулирующий функции рисования линий. Он может рисовать горизонтальные, вертикальные и диагональные линии. Вы можете добавить необходимые вам события в секцию *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]



Содержание раздела