100分问个图像处理的问题

Question

网上有很多代码可以把PictureBox的图像变灰，现在有个问题不知能否实现，怎样实现？用户把图像加到ImageList后，能不能把其变灰后再draw到picturebox上，而不是draw到picturebox后再变灰，如何实现？

Answer 1

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
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
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
Public Function BmpToBmp() As Picture
    Dim Y As Integer, XX As Long, YY As Long, R&, G&, B&
    Dim PicAry() As Byte
    Dim W As Long, H As Long    With ImageList1.ListImages(1)
        W = .Picture.Width / 15
        H = .Picture.Height / 15
        
        ReDim PicAry(W * 3 - 1, H - 1) As Byte
        
        Call GetBitmapBits(.Picture.Handle, W * 3 * H - 1, PicAry(0, 0))
        For YY = 0 To H - 1 Step 1
            For XX = 0 To W - 1 Step 1
                R = PicAry(XX * 3 + 2, YY): G = PicAry(XX * 3 + 1, YY): B = PicAry(XX * 3, YY)
                Y = (299 * R + 587 * G + 114 * B) / 1000
                PicAry(XX * 3 + 2, YY) = Y: PicAry(XX * 3 + 1, YY) = Y: PicAry(XX * 3, YY) = Y
            Next XX
        Next YY
        Call SetBitmapBits(.Picture.Handle, W * 3 * H - 1, PicAry(0, 0))
        Set BmpToBmp = .Picture
    End With
End Function

Answer 2

是可以的
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
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
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
Public Function BmpToBmp() As Picture
    Dim Y As Integer, XX As Long, YY As Long, R&, G&, B&
    Dim PicAry() As Byte
    Dim W As Long, H As Long    With ImageList1.ListImages(1)
        W = .Picture.Width / 15
        H = .Picture.Height / 15
        
        ReDim PicAry(W * 3 - 1, H - 1) As Byte
        
        Call GetBitmapBits(.Picture.Handle, W * 3 * H - 1, PicAry(0, 0))
        For YY = 0 To H - 1 Step 1
            For XX = 0 To W - 1 Step 1
                R = PicAry(XX * 3 + 2, YY): G = PicAry(XX * 3 + 1, YY): B = PicAry(XX * 3, YY)
                Y = (299 * R + 587 * G + 114 * B) / 1000
                PicAry(XX * 3 + 2, YY) = Y: PicAry(XX * 3 + 1, YY) = Y: PicAry(XX * 3, YY) = Y
            Next XX
        Next YY
        Call SetBitmapBits(.Picture.Handle, W * 3 * H - 1, PicAry(0, 0))
        Set BmpToBmp = .Picture
    End With
End FunctionPrivate Sub Form_Load()
Picture1.AutoRedraw = True
Picture1.PaintPicture BmpToBmp, 0, 0, Picture1.Width, Picture1.Height, 0, 0
End Sub

Answer 3

我刚调试过没有问题啊!调用:
Set Picture1.Picture=BmpToBmp

Answer 4

我知道了，我的ImageList加的是icon，所以上面的代码才不起作用

Answer 5

图片是ICON或Gif格式不可以,以上只能转换位图

Answer 6

我的ImageList加载的主要是icon图标

Answer 7

以下可以处理各种格式图片:
Public Sub BmpGray(ByVal Pic As PictureBox)
    Dim PicBits() As Byte, PicInfo As BITMAP, BytesPerPixel As Long
    Dim R As Byte, G As Byte, B As Byte, Gray As Byte, i As Long
    With Pic
        .AutoRedraw = True
        GetObject .Image, Len(PicInfo), PicInfo
        BytesPerPixel = PicInfo.bmBitsPixel \ 8
        ReDim PicBits(1 To PicInfo.bmWidth * PicInfo.bmHeight * BytesPerPixel)
        GetBitmapBits .Image, UBound(PicBits), PicBits(1)
        For i = 0 To UBound(PicBits) \ BytesPerPixel - 1
            B = PicBits(i * BytesPerPixel + 1)
            G = PicBits(i * BytesPerPixel + 2)
            R = PicBits(i * BytesPerPixel + 3)
            Gray = R * 0.39 + G * 0.5 + B * 0.11
            '下面这一句是将灰度值换算成二值
            ' If Gray > 127 Then Gray = 255 Else Gray = 0
            PicBits(i * BytesPerPixel + 1) = Gray
            PicBits(i * BytesPerPixel + 2) = Gray
            PicBits(i * BytesPerPixel + 3) = Gray
        Next i
        SetBitmapBits .Image, UBound(PicBits), PicBits(1)
        .Refresh
    End With
End Sub

Answer 8

我想要的是从imagelist取出一个icon后在画到picturebox或form之前就进行灰度处理，然后再把这个灰度图画到picturebox或form等对像上.不知能不能先把图像画到内存DC后再变灰，再拷到窗体上呢？应如何做？

Answer 9

请各位帮我看看下面的代码错在那? 画出来的是一个黑色方块，并不是原来的图形了Option ExplicitPrivate Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (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 Long
Private Const ILD_TRANSPARENT                   As Long = &H1
Private Sub Command1_Click()
 
   Dim lngWidth        As Long
   Dim lngHeight       As Long
   Dim hMemDC          As Long
   Dim hDesDC          As Long
   Dim hMemBMP         As Long
   Dim hOldBMP         As Long
   
   lngWidth = ImageList1.ImageWidth
   lngHeight = ImageList1.ImageHeight
   hDesDC = Picture1.hdc
   
   hMemDC = CreateCompatibleDC(hDesDC)
   hMemBMP = CreateCompatibleBitmap(hMemDC, lngWidth, lngHeight)
   hOldBMP = SelectObject(hMemDC, hMemBMP)
   ImageList1.ListImages(1).Draw hMemDC, 0, 0, ILD_TRANSPARENT
   
   BitBlt hDesDC, 0, 0, lngWidth, lngHeight, hMemDC, 0, 0, vbSrcCopy
   
   SelectObject hMemDC, hOldBMP
   DeleteObject hMemBMP
   DeleteDC hMemDC
   
End Sub

Answer 10

没必要非要先变灰再draw啊
以上改为:
Private Sub Command1_Click()
   Dim lngWidth        As Long
   Dim lngHeight       As Long
   Dim hMemDC          As Long
   Dim hDesDC          As Long
   Dim hMemBMP         As Long
   Dim hOldBMP         As Long
   
   lngWidth = ImageList1.ImageWidth
   lngHeight = ImageList1.ImageHeight
   hDesDC = Picture1.hdc
   
   hMemDC = CreateCompatibleDC(hDesDC)
   hMemBMP = CreateCompatibleBitmap(hMemDC, lngWidth, lngHeight)
   
   hOldBMP = SelectObject(hMemDC, hMemBMP)
   ImageList1.ListImages(1).Draw hMemDC, 0, 0
   
   BitBlt hDesDC, 0, 0, lngWidth, lngHeight, hMemDC, 0, 0, vbSrcCopy
   
   SelectObject hMemDC, hOldBMP
   DeleteObject hMemBMP
   DeleteDC hMemDC
   
End Sub

Answer 11

将彩色图像转换为灰度图像，其实网上都有很多高效的代码。
帮你找一个：
http://www.samlong.cn/soft/67/77/222/2007/20070110102085.html

Answer 12

将hMemBMP = CreateCompatibleBitmap(hMemDC, lngWidth, lngHeight)
改为
hMemBMP = CreateCompatibleBitmap(hDesDC, lngWidth, lngHeight)
就不再是黑块了。
不过，由于hMemBmp默认的背景是黑色，而你又使用ImageList1.ListImages(1).Draw hMemDC, 0, 0, ILD_TRANSPARENT进行透明绘制，结果使用BitBlt后将出现黑色的背景。
解决办法：
一、让ImageList1直接在Picturebox上透明绘制。
二、或者，将hMemBmp的背景填充为PictureBox的背景。
三、或者，使用TransparentBlt而不是BitBlt。

Answer 13

不用再迷茫了，不必再痛苦了，快来用DrawState函数吧~~
fuFlags参数设为DSS_DISABLED或DSS_MONO（需指定画刷）。

Answer 14

如果想自己实现，可以用N多API模拟DrawState的效果。比较繁琐。
图标是由两个位图组成的，楼主需要把其中叫做IMAGE的那个位图灰化。
灰化需要用到DIB段以提高速度。
之后的数据，如果想借助于绘制ICON的API，还要用CreateIconIndirect等再重建为ICON，要不这些函数才不知道你的那些数据是什么呢。当然也可以直接使用，直接当BMP来绘制，需要多次调用BitBlt，配合适当的RO2操作，使那两个位图“IMAGE”和“MASK”形成一个透明的效果（就是图标效果）。