Программное передвижение курсора мыши

← →
European (2004-03-12 20:27) [0]

Здравствуйте!!!
Уважаемые Мастера! Пытаюсь сделать так, чтобы мышь перемещалась по TPanel (хотя это неважно) с некоторым дискретным шагом, например, в 10 точек. Подскажите, как правильно это реализовать.
Ниже приведен код одной из моих попыток. При таком решении курсор пробегает по всей панели от начала до конца. Приходится вводить счётчик для задержки, но это, по-моему, вообще через ... (не буду выражаться).
Помогите, пожалуйста. Заранее благодарю!

var Last_X, Last_Y: LongInt; scnd_stp: boolean; procedure TForm1.FormCreate(Sender: TObject); begin Last_X:=0; Last_Y:=0; scnd_stp:=false; end; procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var delta_x, delta_y: SmallInt; begin if scnd_stp then begin if X>Last_X then delta_x:=10 else delta_x:=-10; if Y>Last_Y then delta_y:=10 else delta_y:=-10; if X=Last_X then delta_x:=0; if Y=Last_Y then delta_y:=0; mouse_event(MOUSEEVENTF_MOVE,delta_x,delta_y,0,0); Last_X:=X; Last_Y:=Y; end else begin Last_X:=X; Last_Y:=Y; scnd_stp:=true; end; end;

← →
YuRock © (2004-03-12 20:30) [1]

BOOL SetCursorPos( int X, // horizontal position int Y // vertical position );

где X, Y - экранные координаты. Переведи клиентские координаты в экранные с помощью ClientToScreen и используй ее

← →
TUser © (2004-03-12 20:31) [2]

Screen.Mouse, кажется. Короче, Screen, потом точка, а потом - там сеймантически однозначно интерпретируемое название. Я его наизусть не помню.

← →
European (2004-03-12 20:35) [3]

Я пользовался SetCursorPos. Результат - тот же. Курсор перемещается до тех пор пока не пробежит по всему компоненту. Нужна задержка. Как?

← →
European (2004-03-12 21:19) [4]

Я пытался использовать Sleep, таймер, счётчик, но всё это мне не очень нравится. Подскажите как лучше сделать

← →
YuRock © (2004-03-12 21:36) [5]

Просто не надо двигать бесконечно. Надо хранить последнюю позицию и, проанализировав ее, переставлять курсор, или нет

← →
European (2004-03-12 22:25) [6]

Я это понимаю. Обработка движения идёт в OnMouseMove. Как только курсор переставляется OnMouseMove срабатывает снова. Вот здесь и образуется цикл, прерываемый когда мышь уходит за предел компонента.

← →
European (2004-03-12 22:28) [7]

Может я плохо пояснил? Мне нужно подобие привязки к сетке, реализованное в различных САПР.

← →
Mihey © (2004-03-13 00:38) [8]

Проблема в том, что для достижения нужного эффекта необходимо разделить изображение и координаты курсора. Пока координаты курсора остаются внутри какой-то ячейки (вокруг контрольной точки), изображение должн ыбыть в контрольной точке. Но это не значит, что координаты должны быть там. Вот мой код:

unit unitMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;

type
TformMain = class(TForm)
panelGrid: TPaintBox;
procedure panelGridMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
procedure panelGridPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
formMain: TformMain;

const
GSize = 25; // GridSize

var
CurPos: TPoint;
Ico: TIcon;

implementation

{$R *.DFM}

procedure TformMain.panelGridMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var CPos: TPoint;
PPos: TPoint;
x0, y0: Integer;
begin
CPos := Mouse.CursorPos;
x0 := X div GSize + 1;
y0 := Y div GSize + 1;
If (CurPos.x <> x0) or (CurPos.y <> y0) then
begin
CurPos := Point(x0, y0);
x0 := (x0-1)*GSize;
y0 := (y0-1)*GSize;
// SetCursorPos(panelGrid.ClientToScreen(Point(x0,y0)).x,
// panelGrid.ClientToScreen(Point(x0,y0)).y);
panelGrid.Repaint;
panelGrid.Canvas.Draw(x0, y0, Ico);
end;
end;

procedure TformMain.FormCreate(Sender: TObject);
begin
CurPos := Point(-1, -1);
Ico := TIcon.Create;
Ico.Handle := LoadCursor(0, PChar(IDC_ARROW));
DoubleBuffered := True;
end;

procedure TformMain.panelGridPaint(Sender: TObject);
var x: Integer;
begin
panelGrid.Canvas.Pen.Color := clBlack;
panelGrid.Canvas.Rectangle(0, 0, panelGrid.Width-1, panelGrid.Height-1);
for x := 1 to panelGrid.Width div GSize do
begin
panelGrid.Canvas.MoveTo(x*gsize, 0);
panelGrid.Canvas.LineTo(x*gsize, panelGrid.Height-1);
end;
for x := 1 to panelGrid.Height div GSize do
begin
panelGrid.Canvas.MoveTo(0, x*gsize);
panelGrid.Canvas.LineTo(panelGrid.Width-1, x*gsize);
end;
panelGrid.Canvas.Pen.Color := clGray;
for x := 0 to panelGrid.Width div GSize-1 do
begin
panelGrid.Canvas.MoveTo(x*gsize + gsize div 2, 0);
panelGrid.Canvas.LineTo(x*gsize + gsize div 2, panelGrid.Height-1);
end;
for x := 0 to panelGrid.Height div GSize-1 do
begin
panelGrid.Canvas.MoveTo(0, x*gsize + gsize div 2);
panelGrid.Canvas.LineTo(panelGrid.Width-1, x*gsize + gsize div 2);
end;
end;

procedure TformMain.FormDestroy(Sender: TObject);
begin
Ico.Free;
end;

end.

Готовый проект с откомпилированным EXE:
http://www.hot.ee/mvps16/grid.rar

← →
European (2004-03-13 00:59) [9]

Спасибо, попробую разобраться

← →
Defunct © (2004-03-13 01:02) [10]

> Может я плохо пояснил? Мне нужно подобие привязки к сетке, реализованное в различных САПР.

IMHO Вы мало САПР видели, более правильным является тот, который не курсор мышки дергает, а объекты размещаят на координатной сетке, пример редактора для САПР:

http://dca.narod.ru/simulation/files/afdk3beta.exe

Общая схема постоения координатной сетки такая:
Создаем объект "Координатная сеть" который должен заниматься отображением объектов, масштабированием и прокруткой. Такой объект обязательно должен включать:

1. То на чем рисовать, к примеру Canvas или Bitmap.
2. Точку отсчета (центр координатной плоскости).
3. Текущий масштаб сетки (ширина одной клеточки в пикселях).
4. Механизм преобразования координат (во внутренние и во внешние).
5. Механизм вызова всех видимых объектов для перерисовки.

Вам сейчас необходимо реализовать 4, без первых 3-х пунктов это реализовать нормально не получится, либо все будет очень криво, либо Вы впоследствии лишитесь каких-то функций (например масштабирование).

Приведу вам пример кода обработчиков OnMouseMove, OnMouseDown, OnMouseUp из рабочего проекта:

procedure TDFrame.DBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Var PT:TPoint; begin If Button = mbLeft Then Begin Case Mode Of m_Explore : ExploreMouseDown(X,Y); m_setObject : SetObject(X,Y); m_setLink : SetLink(X,Y); Else End; End; end; procedure TDFrame.DBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin Case Mode Of m_Explore : ExploreMouseMove(X,Y); m_setObject : ; m_setLink : ; Else End; DBox.FinishDraw; end; procedure TDFrame.DBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Case Mode Of m_Explore : ExploreMouseUp(X,Y); m_setObject : ; m_setLink : ; Else End; end;

Здесь рассмотрим одну из применяемых процедур, например, SetObject:

Procedure TDFrame.SetObject(Corner:TPoint); Var DP : TDrawComponent; Begin // DBox здесь это объект, который инкапсулирует координатную сетку Corner := Dbox.ClientToDBox(Corner); // Вот оно преобразование DP := DC.NewObject; DP.Init(Corner, DBox); DP.SetId( DC.Id ); // DC - это объект который хранит все размещаемые объекты DC.AddItem(DP); DP.ObjectMap.Weight := Random(1000); Dp.Visible := True; DC.ConfigureKnownObject(DP); // Перерисовкой занимается координатная сетка: DBox.RePaint; End; Procedure TDFrame.SetObject(X,Y:Integer); Var Pt:TPoint; Begin Pt.X := X; Pt.Y := Y; SetObject(Pt); End;

← →
European (2004-03-13 01:29) [12]

> IMHO Вы мало САПР видели

Не стоит так говорить:):)
Например, в AutoCAD при включении соответствующего режима курсор мыши двигается строго по узлам сетки, а после этого и объекты привязывает к этим узлам.

← →
European (2004-03-13 01:35) [13]

Спасибо, буду разбираться

European (13.03.04 01:29) [12]
> Например, в AutoCAD при включении соответствующего режима курсор мыши.....
...рисуется средствами координатной сетки AutoCad

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

Программное передвижение курсора мыши Найти похожие ветки