帮我改一下
<p>Option Explicit</p><p>Private Type BITMAPINFOHEADER '40 bytes<br/> biSize As Long<br/> biWidth As Long<br/> biHeight As Long<br/> biPlanes As Integer<br/> biBitCount As Integer<br/> biCompression As Long<br/> biSizeImage As Long<br/> biXPelsPerMeter As Long<br/> biYPelsPerMeter As Long<br/> biClrUsed As Long<br/> biClrImportant As Long<br/>End Type<br/>Private Type RGBQUAD<br/> rgbBlue As Byte<br/> rgbGreen As Byte<br/> rgbRed As Byte<br/> rgbReserved As Byte<br/>End Type<br/>Private Type BITMAPINFO<br/> bmiHeader As BITMAPINFOHEADER<br/> bmiColors As RGBQUAD<br/>End Type</p><p>Private Const DIB_RGB_COLORS As Long = &H0&<br/>Private Const BI_RGB As Long = &H0&<br/>Private Const OBJ_BITMAP As Long = &H7&<br/>Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _<br/> ByVal nNumScans As Long, ByVal lpBits As Long, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long<br/>Declare Function GetCurrentObject Lib "gdi32" (ByVal Hdc As Long, ByVal uObjectType As Long) As Long<br/>Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)<br/>Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long<br/>Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal Hdc As Long) As Long</p><p>'===================================以上不用管他===============================</p><p></p><p><br/>'从左到右.从下往上 顺序<br/>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)</p><p><br/>Dim Bi As BITMAPINFO<br/>Dim LngCol As Long, hMap As Long, LenBuf As Long, R As Long<br/>Dim BmpBuf() As Byte<br/>Dim PX As Long, PY As Long</p><p> On Error GoTo ErrLine</p><p> Find_Color = (&HFF And Find_Color) * &H10000 + (&HFF00& And Find_Color) + _<br/> (&HFF0000 And Find_Color) / &H10000</p><p> With Bi.bmiHeader<br/> .biSize = Len(Bi.bmiHeader)<br/> .biWidth = Width<br/> .biHeight = Height<br/> .biPlanes = 1<br/> .biBitCount = 24<br/> .biCompression = BI_RGB<br/> End With</p><p> LenBuf = (Width) * (Height) * 3<br/> ReDim BmpBuf(LenBuf - 1) 'MsgBox bmpBuf(2359295)<br/> <br/> hMap = GetCurrentObject(Hdc, OBJ_BITMAP)<br/> GetDIBits Hdc, hMap, 0, Bi.bmiHeader.biHeight, VarPtr(BmpBuf(0)), Bi, DIB_RGB_COLORS</p><p> '从左到右.从下往上 顺序<br/> For PY = Height To 1 Step -1<br/> For PX = 1 To Width<br/> CopyMemory LngCol, BmpBuf(R), 3</p><p> If LngCol = Find_Color Then<br/> PoX = PX - 1<br/> PoY = PY - 1<br/> Erase BmpBuf<br/> Exit Function<br/> End If<br/> R = R + 3<br/> Next<br/> Next</p><p>ErrLine:<br/> PoX = -1<br/> PoY = -1<br/> Erase BmpBuf<br/> 'MsgBox "错误号：" & Err.Number & "错误信息：" & Err.Description<br/>End Function<br/></p><p></p><p>'===============================================================</p><p><font color="#ff0000">帮我改成下面的过程........................谢谢</font></p><p><font color="#0000ff">Call FindColor(区域左边：整数, 区域上边：整数, 区域右边：整数, 区域下边：整数, 颜色：字符串, 输出找到的x坐标：整型变量, 输出找到的y坐标：整型变量)<br/></font> <br/></p> <p>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)<br/>Dim Bi As BITMAPINFO<br/>Dim LngCol As Long, hMap As Long, LenBuf As Long, R As Long<br/>Dim BmpBuf() As Byte<br/>Dim PX As Long, PY As Long</p><p> On Error GoTo ErrLine</p><p> Find_Color = (&HFF And Find_Color) * &H10000 + (&HFF00& And Find_Color) + _<br/> (&HFF0000 And Find_Color) / &H10000</p><p> With Bi.bmiHeader<br/> .biSize = Len(Bi.bmiHeader)<br/> .biWidth = Screen.Width / 15<br/> .biHeight = Screen.Height / 15<br/> .biPlanes = 1<br/> .biBitCount = 24<br/> .biCompression = BI_RGB<br/> LenBuf = (.biWidth) * (.biHeight) * 3<br/> ReDim BmpBuf(LenBuf - 1) 'MsgBox bmpBuf(2359295)<br/> End With</p><p> <br/> hMap = GetCurrentObject(GetDC(0), OBJ_BITMAP)<br/> GetDIBits GetDC(0), hMap, 0, Bi.bmiHeader.biHeight, VarPtr(BmpBuf(0)), Bi, DIB_RGB_COLORS</p><p> '从左到右.从下往上 顺序<br/> For PY = Height To mY Step -1<br/> For PX = mX To Width<br/> CopyMemory LngCol, BmpBuf(R), 3</p><p> If LngCol = Find_Color Then<br/> PoX = PX - 1<br/> PoY = PY - 1<br/> Erase BmpBuf<br/> Exit Function<br/> End If<br/> R = R + 3<br/> Next<br/> Next</p><p>ErrLine:<br/> PoX = -1<br/> PoY = -1<br/> Erase BmpBuf<br/> 'MsgBox "错误号：" & Err.Number & "错误信息：" & Err.Description<br/>End Function</p><p>至于第四个参数ByVal Find_Color As Long,为什么要用字符串?</p> <p>大马</p><p></p><p>读出的坐标不对.....可能跟数组有关系////需要改成 2 维的吗???</p><p></p><p></p><p>怎么改成 2维数组...?? 我不会改</p>[此贴子已经被作者于2007-5-29 17:54:45编辑过] <p>怎么不对?</p><p>后面两个参数不是宽与高,而是右下角的坐标的.</p><p>Public Function FindColor([左上X],[左上Y],[右下X],[右下Y], , [返回X], [返回Y])<br/></p>
页:
[1]