一个好烦躁的问题
yeszq 2004-02-27 05:06:45 就是下面这些代码主要功能是先打图变成灰度,然后变成二值化,最后是得到图的匡架但是,MapData数组里面的数是只有0和255但是结果不是这样的,有一些红,绿,蓝的条
Option Explicit
'Win32Api的调用声明
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 Type BITMAPFILEHEADER '位图文件头 大小14 bytes
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER '位图文件信息头 40 bytes
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 '调色板结构 对于24位真彩无效
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO '组织结构
bmiHeader As BITMAPINFOHEADER
bmiColors(256) As RGBQUAD
End Type
Private MapData() As Byte '图形文件中的数据存放区
Private FileSize As Long '图形文件中的数据区大小
Private LineByte As Long '图形中的X轴的数据大小
Private BM As BITMAPINFO
Private BF As BITMAPFILEHEADER
Private Sub ReadBitMap(FileName As String, BitsInfo As BITMAPINFO, BF As BITMAPFILEHEADER _
, Bits() As Byte)
Open FileName For Binary As #1 '位图文件的打开
With BitsInfo.bmiHeader '开域
Get #1, 1, BF '从文件中读结构
If Not BF.bfType = &H4D42 Then Exit Sub '是否为.BMP文件
Get #1, 15, BitsInfo '从文件中读结构
LineByte = ((.biWidth * 24 + 31) / 32 * 4) '位图的宽要是4的倍数
FileSize = LineByte * .biHeight
ReDim Bits(FileSize) '文件在数组中的大小
Get #1, 55, Bits '从文件中读数据到数组中
End With
Close #1 '关闭位图文件
End Sub
Private Sub Command1_Click()
Dim x, y As Long
Dim RGB As Byte
Dim R, g, b As Byte
ReadBitMap "c:\a.bmp", BM, BF, MapData
With BM.bmiHeader '开域
For y = 0 To FileSize - 2
b = Round(MapData(y) * 0.3) '把 RGB 转换成为 YUV (电视信号)也是灰度值
g = Round(MapData(y + 1) * 0.59) 'Y是亮度 UV是色度
R = Round(MapData(y + 2) * 0.11)
RGB = R + g + b '对位图二值化
If RGB > 128 Then
MapData(y) = 255
MapData(y + 1) = 255
MapData(y + 2) = 255
Else
MapData(y) = 0
MapData(y + 1) = 0
MapData(y + 2) = 0
End If
y = y + 2
Next y
SetDIBitsToDevice Picture1.hdc, 0, 0, .biWidth, .biHeight, 0, 0, 0, .biHeight, MapData(0), BM, 0
'对数组的数据放到Picture控件里面
Command2.Enabled = True
End With
End Sub
Private Sub Command2_Click()
Dim a, b, c, d, e, f, g, h As Long
Dim i As Long
Dim GCC As Long
For i = LineByte + 1 To FileSize - LineByte
If MapData(i) = 0 Then '得到一个黑色的点,看八个相邻的点是不是都为黑色
a = MapData((i + LineByte) - 1) '右上
b = MapData(i + LineByte) '上
c = MapData((i + LineByte) + 1) '左上
d = MapData(i - 1) '左
e = MapData(i + 1) '右
f = MapData((i - LineByte) - 1) '右下
g = MapData(i - LineByte) '下
h = MapData((i - LineByte) + 1) '左下
GCC = a + b + c + d + e + f + g + h
If GCC = 0 Then '如果都是黑色的说就设为白色
MapData(i) = 255
End If
End If
Next i
With BM.bmiHeader
SetDIBitsToDevice Picture1.hdc, 0, 0, .biWidth, .biHeight, 0, 0, 0, .biHeight, MapData(0), BM, 0
End With
End Sub
Private Sub Form_Load()
Dim a As Long
Command2.Enabled = False
End Sub