如何用vb将图片二值化？
麻烦各位对此有过研究的仁兄帮忙解答一下，小弟对这一块不甚了解。希望各位提供一些资料，最好是源代码？谢谢！！！！
这种二值化是256位及以下的二值图片，不是RGB的！！！！
[解决办法]
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As LongPrivate Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As LongPrivate tmpPic As PicturePrivate Sub Form_Load() Picture1.ScaleMode = 3 Picture1.AutoRedraw = True Set tmpPic = Picture1.PictureEnd SubPrivate Sub Command1_click()'灰度 Dim width5 As Long, heigh5 As Long, rgb5 As Long Dim hdc5 As Long, i As Long, j As Long Dim bBlue As Long, bRed As Long, bGreen As Long Dim y As Long width5 = Picture1.ScaleWidth heigh5 = Picture1.ScaleHeight hdc5 = Picture1.hdc For i = 1 To width5 For j = 1 To heigh5 rgb5 = GetPixel(hdc5, i, j) bBlue = Blue(rgb5) '获得兰色值 bRed = Red(rgb5) '获得红色值 bGreen = Green(rgb5) '获得绿色值 '将三原色转换为灰度 y = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) \ 32768 '将灰度转换为RGB If y > 72 Then '这个数字可以修改一下看看效果 rgb5 = RGB(255, 255, 255) Else rgb5 = RGB(0, 0, 0) End If SetPixelV hdc5, i, j, rgb5 Next j Next i Set Picture1.Picture = Picture1.ImageEnd SubPrivate Function Red(ByVal mlColor As Long) As Long '从RGB值中获得红色值 Red = mlColor And &HFFEnd FunctionPrivate Function Green(ByVal mlColor As Long) As Long '从RGB值中获得绿色值 Green = (mlColor \ &H100) And &HFFEnd FunctionPrivate Function Blue(ByVal mlColor As Long) As Long ''从RGB值中获得蓝色值 Blue = (mlColor \ &H10000) And &HFFEnd Function
[解决办法]
呵呵，是0和1，但不是 byte类型的0和1，是bit级别的。显然楼主对这个问题本身的了解也不清除，而KillAllCoder如果你用过PS，你可以去了解下PS的位图模式的图像，楼主想得到的是这种。
[解决办法]
Option ExplicitPrivate Const DIB_RGB_COLORS As Long = 0Private Const SRCCOPY As Long = &HCC0020Private Const BI_RGB As Long = 0&Private Type 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 LongEnd TypePrivate Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As ByteEnd TypePrivate Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUADEnd TypePrivate Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As LongEnd TypePrivate Declare Function CreateCompatibleDC Lib "gdi32.dll" ( _ ByVal hdc As Long) As LongPrivate Declare Function CreateCompatibleBitmap Lib "gdi32.dll" ( _ ByVal hdc As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long) As LongPrivate Declare Function SelectObject Lib "gdi32.dll" ( _ ByVal hdc As Long, _ ByVal hObject As Long) As LongPrivate Declare Function BitBlt Lib "gdi32.dll" ( _ ByVal hDestDC As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hSrcDC As Long, _ ByVal xSrc As Long, _ ByVal ySrc As Long, _ ByVal dwRop As Long) As LongPrivate Declare Function GetDIBits Lib "gdi32.dll" ( _ ByVal aHDC As Long, _ ByVal hBitmap As Long, _ ByVal nStartScan As Long, _ ByVal nNumScans As Long, _ ByRef lpBits As Any, _ ByRef lpBI As BITMAPINFO, _ ByVal wUsage As Long) As LongPrivate Declare Function DeleteDC Lib "gdi32.dll" ( _ ByVal hdc As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32.dll" ( _ ByVal hObject As Long) As LongPrivate Declare Function GetBitmapObject Lib "gdi32" Alias "GetObjectA" ( _ ByVal hBitmap As Long, _ ByVal cbBuffer As Long, _ ByRef destBmp As Any) As LongPrivate Sub SavePictureBW(ByVal ctrl As PictureBox, ByVal destfile As String) Dim hdcMono As Long, hbmpMono As Long, hbmpOld As Long, dxBlt As Long, dyBlt As Long, success As Long Dim numscans As Long, byteswide As Long, totalbytes As Long, lfilesize As Long Dim bmpsrc As BITMAP, bmpdst As BITMAP Dim bInfo As BITMAPINFO Dim bitmaparray() As Byte, fileheader() As Byte Dim ff As Integer, by8 'Object's scalemode must be Pixel. dxBlt = ctrl.ScaleWidth dyBlt = ctrl.ScaleHeight 'Create monochrome bitmap from control. hdcMono = CreateCompatibleDC(0) hbmpMono = CreateCompatibleBitmap(hdcMono, dxBlt, dyBlt) success = GetBitmapObject(hbmpMono, Len(bmpsrc), bmpsrc) hbmpOld = SelectObject(hdcMono, hbmpMono) success = BitBlt(hdcMono, 0, 0, dxBlt, dyBlt, ctrl.hdc, 0, 0, SRCCOPY) 'Calculate array size needed for bitmap bits (dword aligned) numscans = dyBlt by8 = dxBlt / 8 If (dxBlt Mod 8) = 0 And (by8 Mod 4) = 0 Then byteswide = by8 Else byteswide = (Int(by8) + 4) - (Int(by8) Mod 4) End If totalbytes = numscans * byteswide ReDim bitmaparray(1 To totalbytes) 'Set BITMAPINFO values to pass to GetDIBits function. With bInfo .bmiHeader.biSize = Len(.bmiHeader) .bmiHeader.biWidth = bmpsrc.bmWidth .bmiHeader.biHeight = bmpsrc.bmHeight .bmiHeader.biPlanes = bmpsrc.bmPlanes .bmiHeader.biBitCount = bmpsrc.bmBitsPixel .bmiHeader.biCompression = BI_RGB End With success = GetDIBits(hdcMono, ctrl.Image, 0, numscans, bitmaparray(1), bInfo, DIB_RGB_COLORS) 'bitmaparray should now contain bitmap bit data. Now create bitmap file header. ReDim fileheader(1 To &H3E) fileheader(1) = &H42 'B fileheader(2) = &H4D 'M lfilesize = UBound(fileheader) + UBound(bitmaparray) fileheader(3) = lfilesize And 255 fileheader(4) = (lfilesize \ 256) And 255 fileheader(5) = (lfilesize \ 65536) And 255 fileheader(6) = (lfilesize \ 16777216) And 255 fileheader(11) = &H3E 'offset fileheader(15) = &H28 'size of bitmapinfoheader fileheader(19) = dxBlt And 255 fileheader(20) = (dxBlt \ 256) And 255 fileheader(21) = (dxBlt \ 65536) And 255 fileheader(22) = (dxBlt \ 16777216) And 255 fileheader(23) = dyBlt And 255 fileheader(24) = (dyBlt \ 256) And 255 fileheader(25) = (dyBlt \ 65536) And 255 fileheader(26) = (dyBlt \ 16777216) And 255 fileheader(27) = 1 fileheader(29) = 1 fileheader(35) = UBound(bitmaparray) And 255 fileheader(36) = (UBound(bitmaparray) \ 256) And 255 fileheader(37) = (UBound(bitmaparray) \ 65536) And 255 fileheader(38) = (UBound(bitmaparray) \ 16777216) And 255 fileheader(47) = 2 fileheader(51) = 2 fileheader(59) = &HFF fileheader(60) = &HFF fileheader(61) = &HFF ff = FreeFile Open destfile For Binary Access Write As #ff Put #ff, , fileheader Put #ff, , bitmaparray Close #ff ' Clean up Call SelectObject(hdcMono, hbmpOld) Call DeleteDC(hdcMono) Call DeleteObject(hbmpMono)End SubPrivate Sub Command1_Click() Call SavePictureBW(Picture1, "d:\123.bmp")End Sub
