DELPHI/Часто задаваемые вопросы и ответы на них/Графика

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

Автор: William E Murto

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

Источник получения информации: http://www.delphiworld.narod.ru