[求助]请问怎么获取屏幕区域所有像素??

dabian001 · 发表于 2007-5-7 22:32:12

请大马帮忙怎么获取屏幕区域所有像素??然后保存为  2种信息1.每个像素点的颜色值 2.每个像素点的坐标//我找了个大概的代码...但是看不懂...不知道是不是我要的代码...///'过程一: 获得一个在PICTURE控件中打开的图像的所有像素 Public Sub DibGet(ByVal IdSource As Long, XBegin As Long, ByVal YBegin As Long, ByVal XEnd As Long, ByVal YEnd As Long) Dim iBitmap As Long Dim iDC As Long Dim I As Long Dim W As Long Dim H As Long     On Error GoTo ErrLine     InPutWid = XEnd - XBegin     InPutHei = YEnd - YBegin     W = InPutWid + 1     H = InPutHei + 1     I = (Bits \ 8) - 1     ReDim ColVal(I, InPutWid, InPutHei)     With bi24BitInfo.bmiHeader         .biBitCount = Bits         .biCompression = 0&         .biPlanes = 1         .biSize = Len(bi24BitInfo.bmiHeader)         .biWidth = W         .biHeight = H     End With     iBitmap = GetCurrentObject(IdSource, 7&)     GetDIBits IdSource, iBitmap, 0&, H, ColVal(0, 0, 0), bi24BitInfo, 0&     DeleteObject iBitmap     Exit Sub ErrLine:

dabian001 · 发表于 2007-5-8 00:02:59

发个GetDIBits... vb环境中312毫秒,,编译运行125毫秒          (p4 2.4GHz  512M   xp_sp2  32位  1024*768 ) 这样的速度应该没有什么争议吧!!!!!!!?????????????......... Option Explicit     Private 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 Type Private Type POINT     x As Integer     y As Integer End Type Private Const DIB_RGB_COLORS        As Long = &H0& Private Const BI_RGB                As Long = &H0& Private Const OBJ_BITMAP            As Long = &H7& Private 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 Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long 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 Function Private Sub Command1_Click()     Dim hdc As Long, sint As Single, retClr() As POINT, ret As Long     sint = Timer     hdc = GetDC(0)     ret = findColor(hdc, 1024, 768, &H0, retClr)     ReleaseDC 0, hdc     MsgBox "此颜色点数:" & ret & " 用时: " & (Timer - sint) End Sub 我找到了一个类似例子;;;但同时发现： find_Color = (&HFF And find_Color) * &H10000 + (&HFF00& And find_Color) + (&HFF0000 And find_Color) / &H10000 当入参find_Color为4位数如（&HFFFF）会出错。 另外Private Function findColor现在是整个屏幕的，哪位能教我改成某个区域的呢。主要本人对 GetDIBits hdc, hMap, 0, bi.bmiHeader.biHeight, VarPtr(bmpBuf(0)), bi, DIB_RGB_COLORS 此语句不甚了解，麻烦给个思路，先谢谢了。

dabian001 · 发表于 2007-5-8 00:21:31

参考其他论坛地址<a href="http://www.vbgood.com/viewthread.php?tid=38272&extra=&page=1">http://www.vbgood.com/viewthread.php?tid=38272&extra=&page=1</a>

马大哈 · 发表于 2007-5-8 10:01:24

GetDIBits hdc, hMap, 0, bi.bmiHeader.biHeight, VarPtr(bmpBuf(0)), bi, DIB_RGB_COLORS这一句貌似是把某DC的内容读到数组中.记得以前看过一个读取BMP象素的代码,就是这样写的.对数组作循环,一般来说还是蛮快的.这个方法也很不错.

dabian001 · 发表于 2007-5-8 12:51:27

帮我整理一个出来好吗....我感觉很乱,,看不懂..改成在某个区域查找某个颜色,,返回坐标的  谢谢

马大哈 · 发表于 2007-5-9 13:03:51

自动加血加蓝?呵呵

马大哈 · 发表于 2007-5-9 13:22:11

findColor这个函数就是这个功能呀.findColor(hdc, 1280, 800, RGB(11, 198, 17), retClr)第一个参数是你要找的目标的DC,得自己想办法得到;第二与第三个参数是坐标最大范围;第四个参数是要找的颜色的值最后一个参数是用于返回所找到的点的坐标.函数返回值是此颜色的点的数量.

dabian001 · 发表于 2007-5-9 14:25:24

Find_Color = (&HFF And Find_Color) * &H10000 + (&HFF00& And Find_Color) + (&HFF0000 And Find_Color) / &H10000这句啥意思??? CopyMemory LngCol, bmpBuf(r), 3这句啥意思???   lenBuf = CLng(Width) * Height * 3这句啥意思??? ReDim Preserve retClr(s)这句啥意思??? Erase bmpBuf这句啥意思???

马大哈 · 发表于 2007-5-9 15:06:30

Find_Color = (&amp;HFF And Find_Color) * &amp;H10000 + (&amp;HFF00&amp; And Find_Color) + (&amp;HFF0000 And Find_Color) / &amp;H10000

貌似某种转换...?

CopyMemory LngCol, bmpBuf(r), 3

指针操作,将3个字节的BYTE复制到一个LONG的内存里去

lenBuf = CLng(Width) * Height * 3

这个忘了.....与DIB位图格式有关的......好象是每个象素使用0-255的三个值来代表它的颜色.....?

ReDim Preserve retClr(s)

在保存数组内容的前提下,对数组扩维

Erase bmpBuf

释放数组所占内存

dabian001 · 发表于 2007-5-9 15:09:17

这样吧..再说个用途....就是想用来做          Photoshop的魔术棒功能

dabian001 · 发表于 2007-5-10 00:36:58

感谢...不过不是我想要的效果...

dabian001 · 发表于 2007-5-10 04:04:09

'iLeft,iTop,iRight,iBottom,szColor Private Function FindColor(ByVal iLeft As Long, ByVal iTop As Long, ByVal iRight As Long, ByVal iBottom As Long, _     ByVal szColor As Long, ByRef FoundX As Long, ByRef FoundY As Long) Dim HDC As Long Dim IntX As Long, IntY As Long Dim r As Long, s As LongDim Bi As BITMAPINFODim LngCol As Long, Hmap As Long, LENbuf As Long Dim BMPbuf() As Byte     'szColor = (&HFF And szColor) * &H10000 + (&HFF00& And szColor) + (&HFF0000 And szColor) / &H10000     With Bi.bmiHeader         .biSize = Len(Bi.bmiHeader)         .biWidth = iRight         .biHeight = iBottom         .biPlanes = 1         .biBitCount = 24         .biCompression = BI_RGB     End With     LENbuf = CLng(iRight) * iBottom * 3     ReDim BMPbuf(LENbuf - 1)     HDC = GetDC(0)     Hmap = GetCurrentObject(HDC, OBJ_BITMAP)     GetDIBits HDC, Hmap, 0, Bi.bmiHeader.biHeight, VarPtr(BMPbuf(0)), Bi, DIB_RGB_COLORS     ReleaseDC 0, HDC     For IntY = iTop To iBottom         For IntX = iLeft To iRight             CopyMemory LngCol, BMPbuf(r), 3             If LngCol = szColor Then                 FoundX = IntX                 FoundY = IntY                 Erase BMPbuf    '释放数组空间                 Exit Function             End If             r = r + 3         Next     Next     FoundX = -1     FoundY = -1 End FunctionPrivate Sub Command1_Click() Dim IntX As Long, IntY As Long Dim sint As Long     sint = Timer                   '左,上, 右,  下, 颜色, x坐标, y坐标     Call FindColor(1, 1, 1023, 767, 255, IntX, IntY)     If IntX > 0 And IntY > 0 Then         MsgBox "此颜色在屏幕坐标为:x=" & IntX & "   y=" & IntY & "  用时:" & (Timer - sint)     Else         MsgBox "查找某颜色坐标失败!!!  用时:" & (Timer - sint)     End If End Sub '//////////////////////////////////////////////////////////////////////////////////////////////////////// 帮我看看哪里有问题?????语法之类的,,,

[此贴子已经被作者于2007-5-10 4:06:28编辑过]

马大哈 · 发表于 2007-5-10 11:59:43

'szColor = (&HFF And szColor) * &H10000 + (&HFF00& And szColor) + (&HFF0000 And szColor) / &H10000这句还是要然后就是输入的参数Call FindColor(1, 1, 1023, 767, 255, IntX, IntY)要纯蓝,应该用RGB函数.Call FindColor(1, 1, 1023, 767, RGB(0,0,255), IntX, IntY)

dabian001 · 发表于 2007-5-10 12:31:10

现在主要是蓝色那快代码..我可能写错了,,根本找不到颜色....坐标

马大哈 · 发表于 2007-5-10 13:33:38

但代码在我这里没错另外,你确认你要找的颜色是纯蓝??RGB(0,0,255)就是纯蓝你用QQ的截图功能看看颜色啊.

dabian001 · 发表于 2007-5-10 14:00:32

大马..你用那代码可以找到,,蓝色坐标????提示什么????我这边一直提示找不到...

马大哈 · 发表于 2007-5-10 16:56:22

也许你的颜色并不是纯蓝(0,0,255).建议先用找色软件看看要找的点的颜色到底是什么样的RGB值(QQ的截图功能就可以看到)

dabian001 · 发表于 2007-5-10 19:04:52

就是算是白色也找不到...我的意思是,,蓝色那段代码有问题...帮我改改..或者告诉我BMPbuf(r) 这个数据的存储方式....

马大哈 · 发表于 2007-5-12 08:48:59

我想这里有你需要的东西:BMP图像格式解析http://blog.csdn.net/kesalin/archive/2006/09/12/1213163.aspx

账号		自动登录	找回密码
密码			加入我们

[求助]请问怎么获取屏幕区域所有像素??

论坛牛人

贡献奖

关注奖

最佳版主

进步奖

人气王

疯狂作品奖

精英奖

赞助论坛勋章

乐于助人勋章