一个关于GetDIBits或者图片格式之类的问题（）

welcometotm 2017-04-08 01:47:09
最近在试着做一个功能，就是找出一张24位图里唯一的RGB值和对应的坐标。思路是通过GetDIBits获取到一个包含R、G、B值的三维数组，在把R,G,B组合并转换成VB的十进制长整数型，再把十进制值当做一个超大数组（个数有16777215个）的元素，把该元素出现的次数，当该元素的值，最后只需要遍历出哪些元素的值为1，就说明该元素的序号就是该图片唯一的RGB值。
可是现在问题来了，前边GetDIBits，合并+转换都OK，就到了遍历超大数组的时候，一张图遍历的特别快，不到3秒，但另一张图就特别慢。最起码3分钟便利不完。
两张图长、宽，位深度，类型，文件头、信息头，大小均一样，可结果天差地别，慢的那个还很容易吧VB搞的失去响应。
拜托大神帮我看看，到底是哪出了问题。
不让上传BMP，所以两个图传到百度网盘了
这个是遍历起来特别慢的图：http://pan.baidu.com/s/1o8e65GA
这个是特别快的： http://pan.baidu.com/s/1bYPr3K
我去，百度盘貌似自动转换成JPG了？好吧，原图打包http://pan.baidu.com/s/1eSaJfG2

那个超大数组就是这个：
For I = 16777215 To 0 Step -1
If ACount(I) = 1 Then
OnlyRGB(z) = String(8 - Len(CStr(I)), "0") & I
If z = 10 - 1 Then Exit For
z = z + 1
End If
DoEvents
Next

以下是完整代码



Option Explicit



Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long

Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BitMapInfo, ByVal wUsage As Long) As Long

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BitMapInfo, ByVal wUsage As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)

Private Declare Function SendMessagebyString Lib "user32" Alias "SendMessageA" (ByVal hWND As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long



'过程中用到的全局变量:

Const Bits As Long = 24         '颜色深度，这里把所有图像都按照32位来处理

Dim ColVal() As Byte                     '用于存放从DIB输入的像素值

Dim InPutHei As Long                    '用于记录输入图像的高度

Dim InPutWid As Long                    '用于记录输入图像的宽度

Dim bi24BitInfo As BitMapInfo           '定义BMP信息

Dim ColLong() As String          '长整形颜色值

Dim OutPutWid As Single

Dim OutPutHei As Single

'数据结构定义:

Private Type BitMapInfoHeader '文件信息头--BITMAPINFOHEADER

    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

    rgbRed   As Byte

    rgbGreen   As Byte

    rgbBlue   As Byte

    'rgbReserved   As   Byte

End Type

  

Private Type BitMapInfo

  bmiHeader   As BitMapInfoHeader

  bmiColors   As RGBQuad

End Type



Private Sub Command1_Click()

    Dim ACount(16777215) As Long    '16777215是RGB的长整数型上限数值

    Dim OnlyRGB() As String

    Dim X As Single, Y As Single, I As Long

    Dim z As Single, zz As Single

    Dim RGBs As Long



    Text1.Text = ""



    DibGet Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight



    OutPutWid = Picture1.ScaleWidth

    OutPutHei = Picture1.ScaleHeight



    ReDim ColLong(OutPutWid, OutPutHei)                 '把R,G,B组合并转换成长整数型

    For X = 0 To OutPutWid - 1

        For Y = 0 To OutPutHei

            RGBs = RGB(CByte(ColVal(2, X, Y)), CByte(ColVal(1, X, Y)), CByte(ColVal(0, X, Y)))

            ColLong(X, Y) = String(8 - Len(CStr(RGBs)), "0") & RGBs

        Next

    Next



    For X = 0 To OutPutWid - 1                          '开始统计。原理是 遍历RGB的长整数型数组，若色值出现，则ACount（色值）数组的值 + 1

        For Y = 0 To OutPutHei                          '下一步只需遍历ACount数组，元素的值代表色值出现的次数。

            ACount(ColLong(X, Y)) = ACount(ColLong(X, Y)) + 1

        Next

    Next



    ReDim OnlyRGB(10 - 1)                               '此处是待选取唯一颜色值的 个数。暂定10个

    z = 0

    '循环ACount数组，就能知道色值出现的次数。

    For I = 16777215 To 0 Step -1                       '倒序是应为喜欢选取亮色。心情设定 ^-^

        If ACount(I) = 1 Then                           '根据需要选取出现规定次数的色值。此处选择出现 1 次

            OnlyRGB(z) = String(8 - Len(CStr(I)), "0") & I   '把长短不一的RGB的长整数型值统一前边补0，变成8位

            If z = 10 - 1 Then Exit For                   '此处是待选取唯一颜色值的 个数。暂定 10 个

            z = z + 1

        End If

        DoEvents

    Next



    If (CStr(Join(OnlyRGB, ""))) = "" Then

        Text1.Text = "出现1次的颜色只有 0 个"

    Else

        Do

            For X = 0 To OutPutWid - 1

                For Y = 1 To OutPutHei

                    If OnlyRGB(zz) = ColLong(X, Y) Then

                        Text1.Text = String(6 - Len(Hex$(ColLong(X, Y))), "0") & Hex$(ColLong(X, Y)) & vbTab & X & "," & OutPutHei - Y & vbCrLf & Text1.Text

                        X = 0: Y = 0: zz = zz + 1

                        If zz = 10 Then Exit Sub

                        GoTo line1

                    End If

                Next

                DoEvents

            Next

line1:

        Loop 'until

    End If

End Sub





Private Sub Picture1_Click()

    Picture1.Picture = LoadPicture(App.Path & "\123.bmp")

End Sub



'获取像素

Private 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 InPutWid As Long, InPutHei As Long

    Dim iDC     As Long, I     As Long, W     As Long, 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:

    MsgBox "错误号:" & Err.Number & ":" & Err.Description

End Sub
...全文
376 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
舉杯邀明月 2017-04-12
  • 打赏
  • 举报
 回复
用Redim 分配的动态数组，其数据空间基本上是在“堆内存”区的，因“空间溢出”覆盖“栈”数据区的可能性还是比较小。 因此我觉得你先前的代码，“崩溃”的原因，应该是调用的API在“写数据”时，因为你给的数据空间不够， 　　它已经写到了“无效地址”的地方去了，因“非法内存访问”错误，造成整个进程被系统“咔嚓”掉了。 　（IDE下调试运行时，你的“程序”的某些非法操作会让IDE跟着遭秧）
舉杯邀明月 2017-04-12
  • 打赏
  • 举报
 回复
你那个“网上抄来的代码”，估计他是获取“RGBA”格式图像数据用的（32位图像数据）， 因为这样无论“宽度”是多少像素，它都是刚好“4字节对齐”的，所以它能直接用三维字节数组。 但是你的是“24位图像数据”，不能保证那个“4字节边界”（宽度刚好是4的整数倍时除外），所以只能用一维数组。
赵4老师 2017-04-12
  • 打赏
  • 举报
 回复
试试处理一个10000×10000的图片。
welcometotm 2017-04-12
  • 打赏
  • 举报
 回复
不错不错，我抄的版本肯定是改过的。程序的原始版本肯定是包括A通道的，你看13行那个Bits 的定义，注释是32位，但定义时改成了24。那个不是我改的。是我抄的时候就有的。一开始我以为无所谓，现在才知道关系重大，哈哈
舉杯邀明月 2017-04-11
  • 打赏
  • 举报
 回复
引用 7 楼 zhao4zhong1 的回复:
总体思路错误。 应逐字节读取图片文件。
信口开河！你这是更大的错误！ 这样操作只对“24位BMP图片文件”有效，其它格式（非24位BMP，和其它编码格式图片文件）， 　　你都需要“自己解码”后才能得到“像素颜色”。
welcometotm 2017-04-11
  • 打赏
  • 举报
 回复
今天有点晚了。等明天程序完全调通了就来结贴。再出现问题还得麻烦各位
welcometotm 2017-04-11
  • 打赏
  • 举报
 回复
对，Chen8013说的很对。当修改了“4字节对齐”以及变三维数组为一维数组后程序再也没有崩溃。 再次非常感谢Chen8013，从指出我数据类型定义有误再到指点我字节对齐，以及指出数组有瑕疵。没有网上大神那种一句话带过的“简略”，反而是红字标注，重点举例。这对于我这个菜菜来说是很认真负责的表现。点赞。 总结起来，大的错误有两点。1是在循环体中数据类型的盲目、错误的使用。2是对数据结构缺乏了解。 那个代码其实是网上抄来的。本来觉得与生俱来就包含RGB分量的三维数组很取巧，就用了。但完全没去在意数组大小的合法性，实在是失败。这是主要原因。根本原因还是因为我对数据结构、数据在内存中存放的形态缺乏系统的了解，这是我自身的缺陷。我本身不是计算机出身 ：P 我也算是兴趣引导了我走上编程这条道路的。（具体糗事可百度我的用户名） 其实zhao4zhong1的意思我明白，他的意思是我不需要加载图片，可以直接从图片文件中通过读取文件的十六进制代码来直接获取RGB，我同样表示感谢。但我确实需要加载进Picturebox。应为我程序的最终形态是通过截取一小部分屏幕（可能最多就100*100）进Picturebox来获取图片中唯一的像素值，而不需要先截屏，在保存为文件，在读取文件。 想法是好的，但我更需要现在这个办法。还是谢谢你。
赵4老师 2017-04-11
  • 打赏
  • 举报
 回复
不压缩的图片格式多了去了。 如果原始图片文件是压缩格式，也应先转换为非压缩格式的图片文件再处理。 且绝对没有必要将整个图片读入内存处理。
赵4老师 2017-04-10
  • 打赏
  • 举报
 回复
总体思路错误。 应逐字节读取图片文件。
舉杯邀明月 2017-04-09
  • 打赏
  • 举报
 回复
按你的“3维字节数组”获取数据的方法，就算“数据区大小”刚好正确， 你在“之后”用ColVal(xxx, xxx, xxx) 取出来的数据，也不会是“某像素”对应的颜色分量。
舉杯邀明月 2017-04-09
  • 打赏
  • 举报
 回复
引用 4 楼 welcometotm 的回复:
Chen8013 谢谢你一直帮我。 麻烦你在帮我看下那个DibGet过程有没有问题？我现在一调试VB不是没有响应就是崩溃。我现在深切怀疑是我GetDIBits 这几句有问题。现在暂时暂时撇开快慢不说，光是这个IDE崩溃就很恼火。 
    iBitmap = GetCurrentObject(IdSource, 7&)
    GetDIBits IdSource, iBitmap, 0&, H, ColVal(0, 0, 0), bi24BitInfo, 0&
    DeleteObject iBitmap
这3句代码，没有任何问题。 有问题的地方是：　在这前面的代码ReDim ColVal(I, InPutWid, InPutHei)这句！ 你的“图像位深度”是24位，也就是“每像素3字节”， 于是，你就认为“获取的图像数据”点用的空间大小，就是“宽度×高度×3”字节了？ 其实你完全搞错了，你这样用，只有“宽度像素数正好是4的倍数”时才正确！ 真实情况是这样的： 每“行”的图像数据连续存放；“每行”占用的数据字节数，以“4字节为边界”对齐。 举个简单的例子：　图像区域大小，是宽7像素、高5像素，24位。 以你的“算法”，定义成3维数组，数据空间就是：3*7*5 = 105字节，对不对？ 可事实是：它会占用120字节空间， 你定义的“3维数组”经常是“空间大小不够”，造成数据区溢出、覆盖，自然就会引起IDE（或程序）崩溃了。 刚才举例中，占用的“120字节”是这样来的： 每行7像素，需要的空间是：　7×3 = 21字节； 　这“21字节”空间要“4字节对齐”，它就会占用24字节，“每行图像数据空间”后面剩余3字节未用的； 共5行图像数据，总共就占用了：　24×5 = 120字节。 由于你的是“24位图像数据”，每像素占用的是3字节，你用“3维字节数组”， 根本就不能正确获取到图像数据（不单是“空间大小”的问题，而是数据位置问题）。 正确的做法，是应该用1维字节数组： 先按我说的“4字节边界对齐”按宽度计算每行占用多少字节；再按“高度”与“每行字节空间”计算总共需要多少字节。 然后定义相应大小的字节数组，传给 GetDIBits( ) 存放图像数据。 这样获取到图像数据后， 哪个“像素”的图像数据“在哪里”，要按它“在第几行（高度方向）、第几个（水平方向）”计算数据起始下标。 这样才能正确“得到像素颜色值”。
welcometotm 2017-04-09
  • 打赏
  • 举报
 回复
Chen8013 谢谢你一直帮我。 麻烦你在帮我看下那个DibGet过程有没有问题？我现在一调试VB不是没有响应就是崩溃。我现在深切怀疑是我GetDIBits 这几句有问题。现在暂时暂时撇开快慢不说，光是这个IDE崩溃就很恼火。 
    iBitmap = GetCurrentObject(IdSource, 7&)
    GetDIBits IdSource, iBitmap, 0&, H, ColVal(0, 0, 0), bi24BitInfo, 0&
    DeleteObject iBitmap
舉杯邀明月 2017-04-08
  • 打赏
  • 举报
 回复
你的Picture1.ScaleMode是什么？ 是像素吗？如果是默认单位（或其它单位）， 获取到的数据是错误的（因为GetDIBits()要求以像素为单位衡量大小），导致“统计结果”是错误的。 尤其是“默认单位”时，你用Picture1.ScaleWidth、Picture1.ScaleHeight得到的“区域”， 是实际值的15*15＝225倍，做了很多的无用功！ 另外，因代码中反复访问数组数据，编译后的exe运行速度会比IDE中运行快得多。 至于你的“修正”是否真正有效，还得拿代码来说话…………
welcometotm 2017-04-08
  • 打赏
  • 举报
 回复
根据 Chen8013 的建议，我修改了Command1_Click过程中所有有可能出错的或导致类型不正确的类型，速度的确是提高了不少，但VB还是很容易失去响应，什么原因啊
舉杯邀明月 2017-04-08
  • 打赏
  • 举报
 回复
处理“整数”、并且这个“值”并不是很大的，居然用字符串方式来处理………… 另外，你的代码 91到104行 中这个大循环，居然直接操作 Text属性………… 你这样的代码，想不慢都难！！！ 我试了一下你的代码： 话说，你的这个代码有“快”的时候吗！ 就算是你说的“快”的那张图片，在执行　91行到104行　这个Do循环也得耗费很长的时间。 （你把101行的“DoEvents”去掉就知道了）
HDC BITMAP BitBlt判断位图是否为黑色GetDIBits
关于GDI,怎样通过 HDC 获取 DC 当前的 HBITMAP https://zhidao.baidu.com/question/1302472552069867299.html HBITMAP bmp=GetCurrentObject(hdc,OBJ_BITMAP);
Delphi下实现全屏快速找图找色
于是乎写了一个专门用于找图找色的单元文件“BitmapData.pas”。在这个单元文件中我实现了从文件中导入位图、屏幕截图、鼠标指针截图、在图片上查找子图、在图片上查找颜色等功能。在查找过程中可以设定颜色变化范围...
VC图像编程
VC图像编程 分类： MFC编程 2013-09-15 13:08 114人阅读 评论(0) ... 图象拼接是在全景视频系统、地理信息系统等应用中经常遇到的一个问题，本文基于网格匹配的方法对边界部分有重叠的图象提出了一
RGB颜色空间与BMP格式图片
BMP 全称 Bitmap-File，是微软出的图像文件格式，它没有进行任何压缩，所以可以直观看出每个像素在文件中如何存储。如下是一段命令行程序，作用是截取当前屏幕，并将其保存为BMP文件。
Delphi图像处理 -- 获取窗口或设备的图像数据
即使是我们认为应该能获取图像的设备上下文句柄，也往往不能达到愿望，如GDI+的TGpBitmap，可以把一个TGpGraphics类型与之关联，按理说，通过TGpGraphics.GetDC获取的设备上下文，应该能获取TGpBitmap的图像数据，...
VB基础类

7,763

社区成员

197,609

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章