SetCursorPos не работает?

Я хотел написать процедуру в delphi для имитации перемещения указателя мыши с определенной скоростью (по аналогии с функцией AutoIT MouseMove). Либо мой код неверен, либо SetCursorPos работает со сбоями после слишком большого количества вызовов. Вот функция, которая у меня есть:

procedure MoveMouse ( X, Y, Speed : Integer);
var
  P     : TPoint;
  NewX  : Integer;
  NewY  : Integer;
begin
  if X < 0 then exit;
  if Y < 0 then exit;
  if X > Screen.Height then exit;
  if Y > Screen.Width then Exit;
  repeat
    GetCursorPos(P);
    NewX := P.X;
    NewY := P.Y;
    if P.X <> X then begin
      if P.X > X then begin
        NewX := P.X - 1;
      end else begin
        NewX := P.X + 1;
      end;
    end;
    if P.Y <> Y then begin
      if P.Y > Y then begin
        NewY := P.Y - 1;
      end else begin
        NewY := P.Y + 1;
      end;
    end;
    sleep (Speed);
    SetCursorPos(NewX, NewY);
  until (P.X = X) and (P.Y = Y);
end;

Я использую это так:

procedure TForm1.btn1Click(Sender: TObject);
var
  X : Integer;
  Y : Integer;
begin
  for X := 0 to Screen.Width do begin
    for Y := 0 to Screen.Height do begin
      MouseClick (X, Y, 1);
    end;
  end;
end;

По какой-то причине указатель мыши застревает в определенной точке X, а затем возвращается к 0,0, но почему?


delphi winapi cursor cursor-position
person Benjamin Weiss    schedule 14.01.2013    source источник

Ответы (1)


arrow_upward
6
arrow_downward

Ваш код застрял, потому что в цикле повторения условие

until (P.X = X) and (P.Y = Y);

никогда не удовлетворяется, когда вы передаете значения X=0 и Y=Screen.Height, поэтому вы должны изменить свой цикл, чтобы передавать только действительные значения координат экрана

  for X := 0 to Screen.Width-1 do
    for Y := 0 to Screen.Height-1 do
      MoveMouse (X, Y, 1);

Также вы можете улучшить свой метод проверки результата GetCursorPos и SetCursorPos.

procedure MoveMouse ( X, Y, Speed : Word);
var
  P     : TPoint;
  NewX  : Integer;
  NewY  : Integer;
begin
  if X > Screen.Width-1  then Exit;
  if Y > Screen.Height-1 then Exit;
  repeat
    if not GetCursorPos(P) then RaiseLastOSError;
    NewX := P.X;
    NewY := P.Y;
    if P.X <> X then
    begin
      if P.X > X then
        NewX := P.X - 1
      else
        NewX := P.X + 1;
    end;

    if P.Y <> Y then
    begin
      if P.Y > Y then
        NewY := P.Y - 1
      else
        NewY := P.Y + 1
    end;
    Sleep (Speed);
    if not SetCursorPos(NewX, NewY) then RaiseLastOSError;
  until (P.X = X) and (P.Y = Y);
end;
person RRUZ    schedule 14.01.2013
comment
Это оно ! Большое спасибо! - person Benjamin Weiss; 14.01.2013