Как реализовать выделение резиновым прямоугольником

Советы » Графика » Как реализовать выделение резиновым прямоугольником

Как реализовать выделение " резиновым прямоугольником" . Иными словами, когда пользоватьль нажимает на левую кнопку мыши и сдвигает ее, на экране появляется прямоугольник, изменяющий размеры при движении мыши, причем все объекты, попавшие в этот прямоугольник выделяются.

В качестве объекта я взял Label, меняющий цвет в зависимости от того, выделен он или нет. При нажатии мышью на форме в FirstPoint кладутся координата курсора. При дальнейшем движении мыши координаты прямоугольника будут высчитываться по FirstPoint и текущим координатам курсора. Причем, чтобы программа нормально отрабатывала случай, когда высота или ширина прямоугольника отрицательная (это произойдет, если увести мышь левее или выше начальной точки), создана процедура NormalRect. NormalRect устанавливает ко Скачать необходимые для компиляции файлы проекта можно на program.dax.ru/subscribe/. http://program.dax.ru/subscribe/index.htm

uses

stdctrls; var

Selecting: boolean = false

; FirstPoint: TPoint; sel: TRect; procedure

DrawRect; begin

with

Form1.Canvas do

begin

Pen.Style := psDot; Pen.Color := clGray; Pen.Mode := pmXor; Brush.Style := bsClear; Rectangle(sel.Left, sel.Top, sel.Right, sel.Bottom); end

; end

; procedure

NormalRect(p1, p2: TPoint); begin

if

p1.x < p2.x then

begin

sel.Left := p1.x; sel.Right := p2.x; end

else

begin

sel.Left := p2.x; sel.Right := p1.x; end

; if

p1.y < p2.y then

begin

sel.Top := p1.y; sel.Bottom := p2.y; end

else

begin

sel.Top := p2.y; sel.Bottom := p1.y; end

; end

; procedure

TForm1.FormCreate(Sender: TObject); var

i: integer; begin

randomize; for

i := 1 to

random(5) + 5 do

begin

with

TLabel.Create(Form1) do

begin

Caption := 'Label' + IntToStr(i); Left := random(Form1.ClientWidth - Width); Top := random(Form1.ClientHeight - Height); Visible := true

; Parent := Form1; end

; end

; end

; procedure

TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin

if

selecting or

(Button < > mbLeft) then

Exit; SetCapture(Form1.Handle); Selecting := true

; FirstPoint := Point(X, Y); sel := Bounds(X, Y, 0, 0); end

; procedure

TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure

SelectLebel(lb: TLabel; r: TRect); var

select: boolean; res: TRect; begin

select := IntersectRect(res, lb.BoundsRect, r); if

select and

(lb.Color = clNavy) then

Exit; if

select then

begin

lb.Color := clNavy; lb.Font.Color := clWhite; end

else

begin

lb.Color := clBtnFace; lb.Font.Color := clBlack; end

; end

; var

i: integer; begin

if

not

Selecting then

Exit; DrawRect; NormalRect(FirstPoint, Point(X, Y)); for

i := 0 to

Form1.ComponentCount - 1 do

if

(Form1.Components[i] is

TLabel) then

SelectLebel(Form1.Components[i] as

TLabel, sel); Application.ProcessMessages; DrawRect; end

; procedure

TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin

if

(not

Selecting) or

(Button < > mbLeft) then

Exit; NormalRect(FirstPoint, Point(X, Y)); DrawRect; ReleaseCapture; Selecting := false

; end

; { Программа была протестирована: Дмитрий Бажин mailto:bsdriver@mail.ru Юрий Кравченко mailto:ykravchenko@ukr.net Все советы и замечания, пожалуйста, присылайте на subscribe@program.dax.ru Всего доброго, Даниил Карапетян. }

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

Категории

Статьи

Советы

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