Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Компонент для отрисовки линий

Автор: 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.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.