Привязка мыши к точке

← →
jack128 © (2004-06-24 16:55) [0]

День добрый.
Многие наверно видели в 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;

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

← →
jack128 © (2004-06-24 17:00) [1]

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

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

← →
Sandman25 © (2004-06-24 17:30) [2]

Я вставил
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:40) [3]

> с другой стороны, если поставить
> with PaintBox.ClientToScreen(c) do
> SetCursorPos(x, y);
> exit;
> в самое начало, то мелькания не будет. Почему, не понимаю.

? Наверно от машины зависит.. У мя и в этом случае мелькает..

← →
default © (2004-06-24 17:41) [4]

у меня вообще не мелькает

← →
jack128 © (2004-06-24 17:51) [5]

гм... Хз.. А проц/память/ОС не могли бы указать?

← →
Sandman25 © (2004-06-24 17:53) [6]

PIV-2GHz, 510MB, Win2000 Server

← →
default © (2004-06-24 17:54) [7]

чудо техника не правда-ли?
пентиум 3, RAM 256, ОС - ME

← →
jack128 © (2004-06-24 17:59) [8]

Может все же у кого мыслишки появились?

У мя duron800/256/WinXP-Home

то ли особенности линейки NT, то ли черт его знает.. Ненавижу!!!!

← →
GuAV © (2004-06-24 18:50) [9]

Мыслишка такая, что как ни крути, MouseMove - вечный гемморой.

> OnMouseMove

можно попробовать WM_MOUSEMOVE. Чем может ускорить?... Вызова динамического метода нет и вроде там какие то ещё лишине поверки...

Ещё +совсем-чуть-чуть FCenter заместо GetCenter.

Ещё можно дизассемблить ClipCursor - у меня опыта в этом нет, но может ты сможешь. Хотя работает ли она без глюков - вопрос.

← →
jack128 © (2004-06-24 19:31) [10]

> Вызова динамического метода нет и

есть. AFAIK любой обработчик соообщения - суть дин метод

> Ещё можно дизассемблить ClipCursor - у меня опыта в этом
> нет

у меня еще меньше. Я вообще с асмом на Вы..

Ладно, к черту, забыли про эту привязку - сделаю опцию, кому нравится - пусть включает, кому не нравиться - пусть сам до пикселя курсор позиционирует ;-)

← →
FX © (2004-06-24 19:39) [11]

type
TForm1 = class(TForm)
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DrawCursor(X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

var
CurPt: TPoint;
Grid: Byte = 12;

{$R *.DFM}

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
dX, dY: Integer;
NewPt: TPoint;
begin
if X mod Grid <= Grid div 2 then dX:=0 else dX:=Grid;
if Y mod Grid <= Grid div 2 then dY:=0 else dY:=Grid;
NewPt:=Point(X div Grid *Grid + dX, Y div Grid *Grid + dY);
Caption:=Format("%d, %d", [NewPt.x, NewPt.y]);
if (NewPt.x = CurPt.x) and (NewPt.y = CurPt.y)then Exit;
DrawCursor(CurPt.x, CurPt.y);
CurPt:=NewPt;
DrawCursor(NewPt.x, NewPt.y);
end;

procedure TForm1.DrawCursor(X, Y: Integer);
begin
with Canvas do begin
Pen.Mode:=pmNotXor;
MoveTo(X, Y-15);
LineTo(X, Y+16);
MoveTo(X-15, Y);
LineTo(X+16, Y);
Brush.Style:=bsClear;
Rectangle(X-3, Y-3, X+4, Y+4);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Cursor:=-1;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
X, Y: Integer;
begin
for X:=0 to Width do
if X mod Grid = 0 then
for Y:=0 to Height do
if Y mod Grid = 0 then
Canvas.Pixels[X, Y]:=clBlack;
end;

end.

← →
QuasiLamo © (2004-06-24 19:45) [12]

> jack128 © (24.06.04 16:55)

А попробуй сделать чтобы курсов вообще на промежуточные позиции... то есть при перемещении мыши указатель прыгал сразу на соседнюю точку сетки... Строго говоря, в автокаде так и сделано кажется...
А не пробовал делать двойную буферизацию?

← →
GuAV © (2004-06-24 19:56) [13]

> есть. AFAIK любой обработчик соообщения - суть дин метод

Не знал. Тогда в OnMouseMove таких вызовов аж два.
Имхо snap-to-grid не для мыши обычно делают а для объекта. см. drag-drop в IDE Delphi.
зы - если это все та же прога, в которой линии проводишь, то я тебе сочувствую

← →
GuAV © (2004-06-24 20:05) [14]

кстати, насчет глючности виндового mousemove - пригрузив комп можно добиться чтоб окно "ShowMessage" таскалось с запозданием!

← →
jack128 © (2004-06-24 20:06) [15]

> [11] FX © (24.06.04 19:39)

Конструктивно. Сенкс.

> А не пробовал делать двойную буферизацию?

курсор отрисововается аппаратно, на него такие вещи не влияют.

> Имхо snap-to-grid не для мыши обычно делают а для объекта.
> см. drag-drop в IDE Delphi.
ну естественно. Это так, я пример накидал. Реально мышкой переносятся элементы схемы.

> если это все та же прога, в которой линии проводишь, то
> я тебе сочувствую
угу, она же. А что так? Туго идет? ;-) Ну так не забывай - у мя экзамены, в июле дела быстрее пойдут..

> Конструктивно. Сенкс.

Хм. Я то же самое написал в ветке про линию (только словамии), а ты сказал, что меня боишься :)
Кстати, наверное знаешь - Electronic Workbench - так она осуществляет snap-to-grid при отпускании, а таскаешь объект и водишь курсор без этого.

> Собственно что мешает скрыть курсор и отрисовывать самому
> в какой угодно позиции как душе угодно...

угу. Это FX предложил, я попробую..

Из архива...

jack128 © (06.06.04 15:32) [41]

> Есть идея такая-скрыть нафиг курсор. рисовать самому курсор
> вместе с линеей и юзер нифига не заподозрит.
Слушай - я тебя боюсь ;-)) С такими приколами юзер у тя инфаркт может схватить..

:-))

← →
MIGUR (2004-06-25 03:33) [20]

Воспользуйся лучше компонентом LMD-Tools 7.0
В нем есть такой компонент как приязка крысы к любой точке монитора, и нетолько, короче чтобы увидеть качай весит 20mb, и crack скачать незабуть. Кстати неодин мой проект необходится без этого компонента. (*_*)

Свойства: Экран -> Настройка -> Дополнительно -> Устранение неполадок -> Отключить ускорение курсора и точечных рисунков. Используйте такую настройку при проблемах с курсором или при просмотре поврежденных файлов изображений.

Привязка мыши к точке Найти похожие ветки