一个好烦躁的问题

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
...全文
48 1 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复

7,785

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧