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

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

Другое по теме:

• Заполнить Canvas рисунком с рабочего стола
• Как вставить изображение в компонент TListBox
• Вывод текста на родительском элементе управления