帮我改一下

dabian001 · 发表于 2007-5-28 17:10:57

Option ExplicitPrivate Type BITMAPINFOHEADER '40 bytes     biSize As Long     biWidth As Long     biHeight As Long     biPlanes As Integer     biBitCount As Integer     biCompression As Long     biSizeImage As Long     biXPelsPerMeter As Long     biYPelsPerMeter As Long     biClrUsed As Long     biClrImportant As Long End Type Private Type RGBQUAD     rgbBlue As Byte     rgbGreen As Byte     rgbRed As Byte     rgbReserved As Byte End Type Private Type BITMAPINFO     bmiHeader As BITMAPINFOHEADER     bmiColors As RGBQUAD End TypePrivate Const DIB_RGB_COLORS As Long = &H0& Private Const BI_RGB As Long = &H0& Private Const OBJ_BITMAP As Long = &H7& Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _         ByVal nNumScans As Long, ByVal lpBits As Long, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long Declare Function GetCurrentObject Lib "gdi32" (ByVal Hdc As Long, ByVal uObjectType As Long) As Long Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal Hdc As Long) As Long'===================================以上不用管他=============================== '从左到右.从下往上顺序 Public Function FindColor(ByVal Hdc As Long, ByVal Width As Long, ByVal Height As Long, ByVal Find_Color As Long, ByRef PoX As Long, ByRef PoY As Long) Dim Bi As BITMAPINFO Dim LngCol As Long, hMap As Long, LenBuf As Long, R As Long Dim BmpBuf() As Byte Dim PX As Long, PY As Long    On Error GoTo ErrLine    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 = (Width) * (Height) * 3     ReDim BmpBuf(LenBuf - 1)    'MsgBox bmpBuf(2359295)         hMap = GetCurrentObject(Hdc, OBJ_BITMAP)     GetDIBits Hdc, hMap, 0, Bi.bmiHeader.biHeight, VarPtr(BmpBuf(0)), Bi, DIB_RGB_COLORS    '从左到右.从下往上顺序     For PY = Height To 1 Step -1         For PX = 1 To Width             CopyMemory LngCol, BmpBuf(R), 3            If LngCol = Find_Color Then                 PoX = PX - 1                 PoY = PY - 1                 Erase BmpBuf                 Exit Function             End If             R = R + 3         Next     NextErrLine:     PoX = -1     PoY = -1     Erase BmpBuf     'MsgBox "错误号：" & Err.Number & "错误信息：" & Err.Description End Function '===============================================================帮我改成下面的过程........................谢谢Call FindColor(区域左边：整数,   区域上边：整数,    区域右边：整数,    区域下边：整数,    颜色：字符串,    输出找到的x坐标：整型变量,    输出找到的y坐标：整型变量)

马大哈 · 发表于 2007-5-29 16:02:17

Public Function FindColor(ByVal mX As Long, ByVal mY As Long, ByVal Width As Long, ByVal Height As Long, ByVal Find_Color As Long, ByRef PoX As Long, ByRef PoY As Long) Dim Bi As BITMAPINFO Dim LngCol As Long, hMap As Long, LenBuf As Long, R As Long Dim BmpBuf() As Byte Dim PX As Long, PY As Long    On Error GoTo ErrLine    Find_Color = (&HFF And Find_Color) * &H10000 + (&HFF00& And Find_Color) + _             (&HFF0000 And Find_Color) / &H10000    With Bi.bmiHeader         .biSize = Len(Bi.bmiHeader)         .biWidth = Screen.Width / 15         .biHeight = Screen.Height / 15         .biPlanes = 1         .biBitCount = 24         .biCompression = BI_RGB         LenBuf = (.biWidth) * (.biHeight) * 3         ReDim BmpBuf(LenBuf - 1)    'MsgBox bmpBuf(2359295)     End With        hMap = GetCurrentObject(GetDC(0), OBJ_BITMAP)     GetDIBits GetDC(0), hMap, 0, Bi.bmiHeader.biHeight, VarPtr(BmpBuf(0)), Bi, DIB_RGB_COLORS    '从左到右.从下往上顺序     For PY = Height To mY Step -1         For PX = mX To Width             CopyMemory LngCol, BmpBuf(R), 3            If LngCol = Find_Color Then                 PoX = PX - 1                 PoY = PY - 1                 Erase BmpBuf                 Exit Function             End If             R = R + 3         Next     NextErrLine:     PoX = -1     PoY = -1     Erase BmpBuf     'MsgBox "错误号：" & Err.Number & "错误信息：" & Err.Description End Function至于第四个参数ByVal Find_Color As Long,为什么要用字符串?