Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

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

Delphi , Графика и Игры , Графика

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

Автор: Даниил Карапетян
WEB сайт: http://program.dax.ru

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

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

Статья Как реализовать выделение резиновым прямоугольником раздела Графика и Игры Графика может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: Графика ::


реклама



©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
21.03.2023 07:12:18/0.042754888534546/2