Keskustelu: Ohjelmointikysymykset: VB6: [vb6] Realistinen hiiren liikutus

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long


Public Const Pi = 3.141592654
Public Type POINTAPI
        x As Long
        y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Sub Wait(ByVal ms As Long)
  ms = timeGetTime() + ms
  Do: DoEvents: Loop While ms > timeGetTime()
End Sub

Public Function Rand(ByVal Low As Long, ByVal High As Long) As Long
  Randomize
  Rand = Int((High - Low + 1) * Rnd) + Low
End Function

Public Sub iMouse(ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, _
                       ByVal range As Long, ByVal segments As Long, _
                       ByVal pcount As Long, ByVal delay As Long)
    Dim u As Double, nc1 As Double, nc2 As Double, nc3 As Double, nc4 As Double
    Dim dummyp As POINTAPI, p1() As POINTAPI, p2() As POINTAPI
    Dim r As RECT, i As Long
    ReDim p2(0)
    ReDim p1(pcount + 2)
    On Error Resume Next
    If segments < 15 Then segments = 50
    segments = segments + Rand(-12, 12)
    GetCursorPos dummyp
    GetWindowRect hwnd, r
    x = x + Rand(-range, range) + r.Left
    y = y + Rand(-range, range) + r.Top
    If pcount < 3 Then pcount = 3
    If (Abs(dummyp.x - x) + Abs(dummyp.y - y)) < 150 Then
        pcount = 3
        segments = 15
    End If

    For i = 0 To pcount + 2
        Select Case i
            Case Is < 2: p1(i) = dummyp
            Case Is >= pcount: p1(i).x = x: p1(i).y = y
            Case Else
                p1(i).x = Min(dummyp.x, x) + Rnd() * Abs(dummyp.x - x)
                p1(i).y = Min(dummyp.y, y) + Rnd() * Abs(dummyp.y - y)
        End Select
    Next i
    For i = 1 To pcount
        For u = 0 To 1 Step (1 / segments)
            nc1 = -(u ^ 3) / 6 + (u * u) / 2 - u / 2 + 1 / 6
            nc2 = (u ^ 3) / 2 - (u * u) + 2 / 3
            nc3 = (-(u ^ 3) + u * u + u) / 2 + 1 / 6
            nc4 = (u ^ 3) / 6
            dummyp.x = nc1 * p1(i - 1).x + nc2 * p1(i).x + nc3 * p1(i + 1).x + nc4 * p1(i + 2).x
            dummyp.y = nc1 * p1(i - 1).y + nc2 * p1(i).y + nc3 * p1(i + 1).y + nc4 * p1(i + 2).y
            ReDim Preserve p2(UBound(p2) + 1)
            p2(UBound(p2)) = dummyp
        Next u
    Next i
    For i = 1 To UBound(p2) - 1
        SetCursorPos p2(i).x, p2(i).y
        Randomize
        Wait Rand(0.1, 6)
    Next i

End Sub

Private Function Min(ByVal val1 As Long, ByVal val2 As Long) As Long
    Min = val1
    If (val2 < val1) Then Min = val2
End Function

procedure WindMouse(xs, ys, xe, ye, gravity, wind, minWait, maxWait, maxStep, targetArea: extended);
var
  veloX, veloY, windX, windY, veloMag, dist, randomDist, lastDist, step: extended;
  lastX, lastY: integer;
  sqrt2, sqrt3, sqrt5: extended;
begin
  sqrt2:= sqrt(2);
  sqrt3:= sqrt(3);
  sqrt5:= sqrt(5);
  while hypot(xs - xe, ys - ye) > 1 do
  begin
    dist:= hypot(xs - xe, ys - ye);
    wind:= minE(wind, dist);
    if dist >= targetArea then
    begin
      windX:= windX / sqrt3 + (random(round(wind) * 2 + 1) - wind) / sqrt5;
      windY:= windY / sqrt3 + (random(round(wind) * 2 + 1) - wind) / sqrt5;
    end else
    begin
      windX:= windX / sqrt2;
      windY:= windY / sqrt2;
      if (maxStep < 3) then
      begin
        maxStep:= random(3) + 3.0;
      end else
      begin
        maxStep:= maxStep / sqrt5;
      end;
    end;
    veloX:= veloX + windX;
    veloY:= veloY + windY;
    veloX:= veloX + gravity * (xe - xs) / dist;
    veloY:= veloY + gravity * (ye - ys) / dist;
    if hypot(veloX, veloY) > maxStep then
    begin
      randomDist:= maxStep / 2.0 + random(round(maxStep) / 2);
      veloMag:= sqrt(veloX * veloX + veloY * veloY);
      veloX:= (veloX / veloMag) * randomDist;
      veloY:= (veloY / veloMag) * randomDist;
    end;
    lastX:= Round(xs);
    lastY:= Round(ys);
    xs:= xs + veloX;
    ys:= ys + veloY;
    if (lastX <> Round(xs)) or (lastY <> Round(ys)) then
      MoveMouse(Round(xs), Round(ys));
    step:= hypot(xs - lastX, ys - lastY);
    wait(round((maxWait - minWait) * (step / maxStep) + minWait));
    lastdist:= dist;
  end;
  if (Round(xe) <> Round(xs)) or (Round(ye) <> Round(ys)) then
    MoveMouse(Round(xe), Round(ye));
end;