Отправляет email-рассылки с помощью сервиса Sendsay

Советы по Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Сентябрь 2001   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Автор
Сергей

Статистика

13.545 подписчиков
-22 за неделю
←   Все выпуски   →

Советы по Delphi


Служба Рассылок Subscribe.Ru проекта Citycat.Ru

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

Во-первых, удобнее всего использовать для этого PaintBox. Для того, чтобы пользователь не переместил конец отрезка за границы PaintBox-а, можно использовать ClipCursor. При нажатии на клавишу мыши область ограничения курсора сузится, при отпускании клавиши - вернется к прежнему состоянию. При движении мыши над PaintBox нужно проверять, далеко ли курсор от концов отрезка, и если близко, то курсор мыши должен меняться.

Поскольку в этом примере всего один отрезок, то при его движении можно перерисовывать весь PaintBox - мигания не будет. Если же рядом с отрезком должно быть нарисовано еще что-то, удобно использовать свойство Pen.Mode, установленное в pmNotXor. В этом режиме отрезок нарисованный два раза подряд на одном и том же месте, стирается, а изображение, бывшее под ним, восстанавливается.

var
  p1, p2: TPoint;

procedure TForm1.FormCreate(Sender: TObject);
begin
  p1 := Point(10, 10);
  p2 := Point(50, 50);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  r: TRect;
begin
  if sqr(X - p1.x) + sqr(Y - p1.y) < 25
    then PaintBox1.Tag := 1;
  if sqr(X - p2.x) + sqr(Y - p2.y) < 25
    then PaintBox1.Tag := 2;
  r := PaintBox1.BoundsRect;
  inc(r.Left, 4);
  dec(r.Right, 4);
  inc(r.Top, 4);
  dec(r.Bottom, 4);
  r.TopLeft := Form1.ClientToScreen(r.TopLeft);
  r.BottomRight := Form1.ClientToScreen(r.BottomRight);
  ClipCursor(@r);
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  r: TRect;
begin
  PaintBox1.Tag := 0;
  r.TopLeft := Point(0, 0);
  with Screen do
  r.BottomRight := Point(Width - 1, Height - 1);
  ClipCursor(@r);
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if PaintBox1.Tag <= 0 then begin
    if ((abs(p1.x - x) < 5) and (abs(p1.y - y) < 5)) or
      ((abs(p2.x - x) < 5) and (abs(p2.y - y) < 5))
      then PaintBox1.Cursor := crSizeAll
      else PaintBox1.Cursor := crDefault;
    Exit;
  end;
  if PaintBox1.Tag = 1
    then p1 := Point(X, Y)
    else p2 := Point(X, Y);
  PaintBox1.Repaint;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  with PaintBox1.Canvas do begin
    Brush.Style := bsSolid;
    FillRect(ClipRect);
    Pen.Color := clRed;
    MoveTo(p1.x, p1.y);
    LineTo(p2.x, p2.y);
    Brush.Style := bsClear;
    Pen.Color := clBlue;
    Rectangle(Bounds(p1.x - 4, p1.y - 4, 8, 8));
    Rectangle(Bounds(p2.x - 4, p2.y - 4, 8, 8));
  end;
end;
Все советы и замечания, пожалуйста, присылайте на delphi4all@narod.ru

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

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу 		Рейтингуется SpyLog
В избранное