Как реализовать выделение резиновым прямоугольником
|
- Как тpи пpогpаммиста могyт оpганизовать бизнес?
- Один пишет виpyсы, а дpyгой антивиpyсы.
- А тpетий?
- Опеpационные системы, под котоpыми это все pаботает.
|
Как реализовать выделение " резиновым прямоугольником" . Иными словами, когда пользоватьль нажимает на левую кнопку мыши и сдвигает ее, на экране появляется прямоугольник, изменяющий размеры при движении мыши, причем все объекты, попавшие в этот прямоугольник выделяются.
В качестве объекта я взял 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
Всего доброго,
Даниил Карапетян.
}
|
|
