Mouse - deslizar ate um controle

Top  Previous  Next

function MouseSlideToControl(const Control: TControl; Jump, JumpTime: Word): boolean;

var

  ToPoint, Pt: TPoint;

 

  function ExecJump: boolean;

  begin

    if (Pt.x = ToPoint.x) and (Pt.y = ToPoint.y) then

    begin

      Result := False; // Chegou

      Exit;

    end;

    // Calcula X

    if Pt.x < ToPoint.x then

    begin

      Inc(Pt.x, Jump);

      if Pt.x > ToPoint.x then // Se passou...

        Pt.x := ToPoint.x;

    end

    else

    if Pt.x > ToPoint.x then

    begin

      Dec(Pt.x, Jump);

      if Pt.x < ToPoint.x then

        Pt.x := ToPoint.x;

    end;

 

    // Calcula Y

    if Pt.y < ToPoint.y then

    begin

      Inc(Pt.y, Jump);

      if Pt.y > ToPoint.y then // Se passou...

        Pt.y := ToPoint.y;

    end

    else

    if Pt.y > ToPoint.y then

    begin

      Dec(Pt.y, Jump);

      if Pt.y < ToPoint.y then

        Pt.y := ToPoint.y;

    end;

    Result := SetCursorPos(Pt.x, Pt.y);

  end;

 

begin

  if Jump = 0 then

  Jump := 1;

 

  SetCursor(Screen.Cursors[Control.Cursor]);

  with Control do begin

  ToPoint.x := Width div 2;

  ToPoint.y := Height div 2;

  ToPoint := ClientToScreen(ToPoint);

  end;

  if GetCursorPos(Pt) then

  while ExecJump do Sleep(JumpTime);

 

  Result := GetCursorPos(Pt) and

  (Pt.x = ToPoint.x) and (Pt.y = ToPoint.y);

end;