【跪求！】下标越界解决方法！！！静等高人出现！！！

Question

本帖最后由 bcrun 于 2011-05-27 08:53:56 编辑

Answer 1

Dim a As Long, b As Long
  a = 0
  b = 0  Dim hdc As Long, sint As Single, retClr() As POINT, ret As Long
  sint = Timer
  hdc = GetDC(0)
  ret = findColor(hdc, 1024, 1024, &HAB7A41, retClr())
  ReleaseDC 0, hdc
'问题可能会出在这里
  if ubound(retClr)-lbound(retClr)>0 then
    SetCursorPos Str(retClr(a).x), Str(retClr(a).y)
  end if
  mouse_event MMOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
  End If

Answer 2

看看这儿吧 对你应该有帮助
http://blog.sina.com.cn/s/blog_5f5f3b080100cltw.html

Answer 3

你可以断点debug下，看看那些变量里面到底是什么

Answer 4

retClr() As POINT  是不是没有申请内存？试试retclt(1000) as point

Answer 5

+++
学会debug，可以解决许多问题

Answer 6

你的retClr没声明好吧。元数个数都没有。要不就用redim再定义一下。

Answer 7

Private Function findColor(ByVal hdc As Long, ByVal Width As Integer, ByVal Height As Integer, ByVal find_Color As Long, ByRef retClr() As POINT) As Long
    Dim bi          As BITMAPINFO
    Dim LngCol      As Long, hMap As Long, lenBuf As Long, r As Long, s As Long
    Dim bmpBuf()    As Byte
    Dim x           As Integer, y As Integer
    Erase retClr
    find_Color = (&HFF And find_Color) * &H10000 + (&HFF00& And find_Color) + (&HFF0000 And find_Color) / &H10000
    With bi.bmiHeader
        .biSize = Len(bi.bmiHeader)
        .biWidth = Width
        .biHeight = Height
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = BI_RGB
    End With
    lenBuf = CLng(Width) * Height * 3
    ReDim bmpBuf(lenBuf - 1)
    hMap = GetCurrentObject(hdc, OBJ_BITMAP)
    GetDIBits hdc, hMap, 0, bi.bmiHeader.biHeight, VarPtr(bmpBuf(0)), bi, DIB_RGB_COLORS
    For y = Height To 1 Step -1
        For x = 1 To Width
            CopyMemory LngCol, bmpBuf(r), 3
            If LngCol = find_Color Then
                ReDim Preserve retClr(s)
                    With retClr(s)
                        .x = x
                        .y = y
                    End With
                s = s + 1
            End If
            r = r + 3
        Next
    Next
    Erase bmpBuf
    findColor = s
End FunctionPrivate Sub Command1_Click()
   Dim a As Long, b As Long
    a = 0
    b = 0    
    
    Dim hdc As Long, sint As Single, retClr() As POINT, ret As Long
    sint = Timer
    hdc = GetDC(0)
    ret = findColor(hdc, 1280, 1024, &H67BF81, retClr())
    ReleaseDC 0, hdc
    SetCursorPos Str(retClr(a).x), Str(retClr(a).y)
    mouse_event MMOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub  高人请指点，最好是能详细点，谢谢！！！