| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Привязка мыши к точке [D5, Win2k, WinXP]

Страницы:   < 1 2 >

jack128 ©   (2004-06-24 16:55:00) 

День добрый.
Многие наверно видели в AutoCAD'e привязку курсора к мыши точке экрана (команда Osnap off/on)
Пытаюсь сделать, что то похоже. Вот что у меня получается:

type
 TForm1 = class(TForm)
   PaintBox: TPaintBox;
   Memo1: TMemo;
   procedure PaintBoxPaint(Sender: TObject);
   procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
 private
   { Private declarations }
   // виртуальные координаты курсора относительно точки привязки, если бы мы не привязывали курсор
   dX, dY: Integer;
   // центр PaintBox'a - та точка к которой привязываемся
   function GetCenter: TPoint;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

const
CrossLen = 5;

procedure TForm1.PaintBoxPaint(Sender: TObject);
begin
 // Ресуем крест в центре пайнтбокса
 with PaintBox.Canvas, GetCenter do
 begin
   MoveTo(x - CrossLen, y);
   LineTo(x + CrossLen + 1, y);
   MoveTo(x, y - CrossLen);
   LineTo(x, y + CrossLen + 1);
 end;
end;

procedure TForm1.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
var
 c: TPoint;
 r: TRect;
begin
 c := GetCenter;
 if (c.x = x) and (c.y = y) then exit;
 // если курсов внутри небольшой области рядом с точкой привязки
 if (abs(X - c.x) <= CrossLen) and (abs(Y - c.y) <= CrossLen) then
 begin
   inc(dX, x - c.x);
   inc(dY, y - c.y);
   if (abs(dX) > CrossLen) or (abs(dY) > CrossLen) then
   begin
     with PaintBox.ClientToScreen(Point(c.x + dx, c.y + dY)) do
       SetCursorPos(x, y);
     dX := 0; dY := 0;
   end
   else
     with PaintBox.ClientToScreen(c) do
       SetCursorPos(x, y);
 end;
end;

function TForm1.GetCenter: TPoint;
begin
 with PaintBox do
 begin
   Result.x := Width div 2;
   Result.y := Height div 2;
 end;
end;

Проблема в том, если курсор медленно перемещать в области привязки, то он мигает. Может у кого есть мысли как этого избежать?

---

Sandman25   (2004-06-24 17:30:00) [21]

Я вставил
  Caption := Caption + IntToStr(abs(X-cx));
перед
  inc(dX, x - c.x);
и увидел, что OnMouseMove вызывается не сразу.
Шут его знает, как заставить событие генерироваться чаще.
с другой стороны, если поставить
with PaintBox.ClientToScreen(c) do
      SetCursorPos(x, y);
exit;
в самое начало, то мелькания не будет.  Почему, не понимаю.

---

jack128   (2004-06-24 17:00:00) [22]

> курсора к мыши точке экрана

естественно курсора мыши к точке экрана. Ну, например к центру окружности или к начальной точке отрезка..

---

Страницы:   < 1 2 >

Наверх