скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

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



Автор: Даниил Карапетян

- Как т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

Всего доброго,
Даниил Карапетян.
}






Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook