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