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

Советы » Компоненты и Графика » Компонент для отрисовки линий

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

.

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

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com