unit Lines; {от Bill Murto, CIS 73730,2505} interface usesSysUtils, 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]