求大神帮我提下速度
以下程序在运行的时候鼠标移动的不连贯，走下停下很明显，求大神修改连贯的移动Do
重新找鼠标颜色:
Dim i, ii, ttt, zX, zY, ppp, pp, qqq, qq, zzX, zzY, ux, uy, Screenx, Screeny As Long
Dim p() As Long
Dim Q() As Long
Dim hmemDC As Long, hmemBMP As Long, bmp_info As BITMAPINFO, lpBits As Long
Dim dwX As Long, dwY As Long
Dim PicData() As Byte
Dim ScreenDC As Long
Dim TargetColor As Long
Dim crColor As RGBCOLOR
i = 0
TargetColor = &H68E8E8 '为游戏鼠标的特征颜色值16进制
CopyMemory crColor, TargetColor, 4
ScreenDC = GetDC(0)
With bmp_info.bmiHeader
.biSize = LenB(bmp_info.bmiHeader)
.biWidth = Screen.Width / Screen.TwipsPerPixelX
.biHeight = Screen.Height / Screen.TwipsPerPixelY
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
.biSizeImage = .biHeight * (((.biWidth * .biBitCount + 31) And &HFFFFFFE0) \ 8)
End With
hmemDC = CreateCompatibleDC(ScreenDC)
hmemBMP = CreateDIBSection(ScreenDC, bmp_info, DIB_RGB_COLORS, lpBits, 0, 0)
SelectObject hmemDC, hmemBMP
BitBlt hmemDC, 0, 0, bmp_info.bmiHeader.biWidth, bmp_info.bmiHeader.biHeight, ScreenDC, 0, 0, vbSrcCopy
ReDim PicData(3, bmp_info.bmiHeader.biWidth - 1, bmp_info.bmiHeader.biHeight - 1) As Byte
CopyMemory PicData(0, 0, 0), ByVal lpBits, bmp_info.bmiHeader.biSizeImage
'Debug.Print "查找坐标范围：(0,0) - (" & CStr(bmp_info.bmiHeader.biWidth - 1) & "," & CStr(bmp_info.bmiHeader.biHeight - 1) & ")"
For dwY = 0 To bmp_info.bmiHeader.biHeight - 1
For dwX = 0 To bmp_info.bmiHeader.biWidth - 1
If (PicData(0, dwX, dwY) = crColor.rgbBlue) And (PicData(1, dwX, dwY) = crColor.rgbGreen) And (PicData(2, dwX, dwY) = crColor.rgbRed) Then
'And (PicData(0, dwX+10, dwY-10) = crColor.rgbBlue) And (PicData(1, dwX+10, dwY-10) = crColor.rgbGreen) And (PicData(2, dwX+10, dwY-10) = crColor.rgbRed)
'Debug.Print "找到目标颜色，坐标：" & CStr(dwX) & "," & CStr(bmp_info.bmiHeader.biHeight - dwY - 1)
ReDim Preserve p(i)
ReDim Preserve Q(i)
p(i) = CStr(dwX)
Q(i) = CStr(bmp_info.bmiHeader.biHeight - dwY - 1)
i = i + 1
End If
Next
Next
'MsgBox "查找结束"
DeleteDC hmemDC
DeleteObject hmemBMP
ReleaseDC 0, ScreenDC
'分析横纵坐标,找到满足点P,Q的坐标返回值是P的坐标“-705”和“-68”是2个坐标的差值
For i = 0 To i - 1
For ii = 0 To i - 1
If p(i) - 10 = p(ii) And Q(i) + 10 = Q(ii) Then
'Debug.Print "坐标" & p(i) & "," & Q(i) & "和坐标" & p(ii) & "," & Q(ii)
GoTo exitendfenxi:
End If
Next
Next
'Debug.Print "没有找到符合要求的坐标"
GoTo 重新找鼠标颜色:
exitendfenxi:
zX = p(i) - 19
zY = Q(i) - 10 '游戏鼠标坐标
If zX > 0 Or zY > 0 Then
zzX = zX
zzY = zY
Else
zX = zzX
zY = zzY
Sleep 20
End If
If Abs(intX - zX) < 3 Then
ppp = 0
End If
If Abs(intX - zX) > 20 Then
Randomize
ppp = Int(Rnd() * 3 + 5)
If Abs(intX - zX) > Abs(intY - zY) Then
ppp = ppp
ElseIf Abs(intX - zX) < Abs(intY - zY) Then
ppp = Int(ppp * (Abs(intX - zX) / Abs(intY - zY)))
End If
ElseIf 50 > Abs(intX - zX) Then
ppp = 1
End If
If intX > zX Then
pp = ppp
ElseIf intX < zX Then
pp = -ppp
ElseIf Abs(intX - zX) < 3 Then
pp = 0
End If
If Abs(intY - zY) < 3 Then
qqq = 0
End If
If Abs(intY - zY) > 20 Then
Randomize
qqq = Int(Rnd() * 3 + 5)
If Abs(intX - zX) > Abs(intY - zY) Then
qqq = Int(qqq * (Abs(intY - zY) / Abs(intX - zX)))
ElseIf Abs(intX - zX) < Abs(intY - zY) Then
qqq = qqq
End If
ElseIf 50 > Abs(intY - zY) Then
qqq = 1
End If
If intY > zY Then
qq = qqq
ElseIf intY < zY Then
qq = -qqq
ElseIf Abs(intY - zY) < 3 Then
qq = 0
End If
GetCursorPos moubegin
If moubegin.X > 650 Or moubegin.Y > 500 Or moubegin.X < 10 Or moubegin.Y < 10 Then
Randomize
MoveTo Int(Rnd() * 100 + 300), Int(Rnd() * 100 + 200)
Sleep 200
End If
mousestep = moubegin
SetCursorPos moubegin.X + pp, moubegin.Y + qq
Sleep 2
Loop While Abs(intY - zY) > 2 Or Abs(intX - zX) > 2
