图片灰度化。

Option Explicit

'图像处理的一个例子
'Powered by Jadeluo , 2004/02/21
'EMail: Jadeluo@sina.com

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

Private Sub Command3_Click()
SavePicture picShow.Image, "C:\TZSignTemp111.bmp"

End Sub

Private Sub Form_Load()
picShow.BorderStyle = vbBSNone
picShow.Move 0, 0
End Sub

Private Sub Command1_Click()
On Error Resume Next
With CommonDialog1
.Filter = "Picture(*.BMP;*.JPG;*.GIF;*.ICO)|*.BMP;*.JPG;*.GIF;*.ICO|All Files(*.*)|*.*"
.CancelError = True
.ShowOpen
If Err.Number = 0 Then
picShow.AutoSize = True
picShow.Picture = LoadPicture(.FileName)
End If
End With
On Error GoTo 0
End Sub

Private Sub Command2_Click()
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 picShow
.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