【100分】如果获取位图颜色比例
如何根据一个BMP图片获得这个图片各种颜色占的比率,比如上图(请看图的时候忽略白色线,实际图是无白色线的):
浅灰:25%
深灰:25%
深蓝:25%
浅蓝:25%
我有个想法,就是把位图读到一个二维数组,然后再计算,但是我没做个类似操作,希望各位大侠能示范下!最好提供源码,谢谢!
■■■■
[最优解释]
最简单的办法:
如果不使用API,则set pic=loadpicture(bmpfile),然后使用point获得图片像素颜色,最后作比较。
稍复杂的办法:
创建一个内存DC,然后将该bmp选入DC,再用getpixels获得像素的颜色,最后比较。
最高效还也较复杂的办法:
重复上述步骤,但直接访问内存中的位图数据(可以使用模拟指针转换为VB的bytes数组),最后直接访问数组获得像素颜色并比较。
[其他解释]
lyserver你好!
用:set pic=loadpicture(bmpfile),然后使用point获得图片像素颜色
这个方法非常慢,你说的另外几种方法能提供下源代码吗?
[其他解释]
直接按 BMP 文件格式读取数据:
http://topic.csdn.net/t/20020409/20/634570.html
[其他解释]
mark~
[其他解释]
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte
Dim PicInfo As BITMAP
Dim Cnt As Long
Dim BytesPerLine As Long
Dim xArrayx As XArrayDB
Private Sub Command1_Click()
Dim iRow As Long
GetObject Pic.Image, Len(PicInfo), PicInfo
BytesPerLine = (PicInfo.bmWidth * 3 + 3) And &HFFFFFFFC
ReDim PicBits(1 To BytesPerLine * PicInfo.bmHeight * 3) As Byte
GetBitmapBits Pic.Image, UBound(PicBits), PicBits(1)
Set xArrayx = New XArrayDB
xArrayx.Clear
xArrayx.ReDim 1, 1, 1, 3
xArrayx(1, 1) = Format(CStr(PicBits(3)), "000") & Format(CStr(PicBits(2)), ",000") & Format(CStr(PicBits(1)), ",000")
Debug.Print Format(CStr(PicBits(3)), "000") & Format(CStr(PicBits(2)), ",000") & Format(CStr(PicBits(1)), ",000")
xArrayx(1, 2) = Format(CStr(255 - PicBits(3)), "000") & Format(CStr(255 - PicBits(2)), ",000") & Format(CStr(255 - PicBits(1)), ",000")
xArrayx(1, 3) = 1
For Cnt = 5 To UBound(PicBits) Step 4
Debug.Print Format(CStr(PicBits(Cnt + 2)), "000") & Format(CStr(PicBits(Cnt + 1)), ",000") & Format(CStr(PicBits(Cnt)), ",000")
iRow = xArrayx.Find(1, 1, Format(CStr(PicBits(Cnt + 2)), "000") & Format(CStr(PicBits(Cnt + 1)), ",000") & Format(CStr(PicBits(Cnt)), ",000"))
If iRow > 0 Then
xArrayx(iRow, 3) = Val(xArrayx(iRow, 3)) + 1
Else
xArrayx.ReDim 1, xArrayx.UpperBound(1) + 1, 1, 3
xArrayx(xArrayx.UpperBound(1), 1) = Format(CStr(PicBits(Cnt + 2)), "000") & Format(CStr(PicBits(Cnt + 1)), ",000") & Format(CStr(PicBits(Cnt)), ",000")
xArrayx(xArrayx.UpperBound(1), 2) = Format(CStr(255 - PicBits(Cnt + 2)), "000") & Format(CStr(255 - PicBits(Cnt + 1)), ",000") & Format(CStr(255 - PicBits(Cnt)), ",000")
xArrayx(xArrayx.UpperBound(1), 3) = 1
End If
Next Cnt
Set tdbgDetail.Array = xArrayx
tdbgDetail.ReBind
tdbgDetail.Refresh
End Sub