vb 图像处理问题咨询
目前 ,我正在用vb做些图像处理的学习,可是有以下几个问题存在瓶颈:1在vb中如何把一副图片转为数组表示的方法,就像matlab中的imread. 以及把数组转为图像显示出来;
2, 在进行图形的二值化,目前是否有比较合适的函数直接调用,还是要自己编写。
再次谢谢大家 了。 直接使用Open读取即可 也可以这样:
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'函数功能:把指定路径下的BMP文件以二进制方式读入数组
'参数说明:strFileName:BMP文件全路径
' :picP:二值化处理的目标图片框
'返 回 值:成功,返回True,失败,返回False
'附加说明:只能读取24位和8位的位图
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Public Function funReadBMPByBin(ByVal strFileName As String, ByRef picP As PictureBox, _
ByVal intLow As Integer, ByVal intTop As Integer) As Boolean
Dim colornum, i As Integer
Dim j As Integer
Dim kk As Integer
Dim l As Integer
Dim bf As bitmapfileheader
Dim bl As bitmapinfoheader
Dim xpos As Long
Dim ypos As Long
Dim rgbpalette(256, 3) As Byte
Dim piccol(1024, 1024, 2) As Byte
Dim pix As Byte
Dim col As Byte
Dim index As Byte
Dim palentry As Byte
Dim unused As Integer
Dim palettesize As Integer
Dim r As Integer
Dim g As Integer
Dim b As Integer
Dim c As Integer
On Error GoTo errFun
funReadBMPByBin = False
Open strFileName For Binary As #1
Get #1, , bf
Get #1, , bl
xpos = bl.biwidth
ypos = bl.biheight
colornum = bl.bibitcount
Screen.MousePointer = 12
Select Case colornum
Case 24
For i = 0 To ypos - 1
For j = 0 To xpos - 1
For l = 0 To 2
Get #1, , col
piccol(j, i, l) = col
Next
Next
If Int((xpos * 3) / 4) <> (xpos * 3) / 4 Then
For kk = 1 To 4 - ((xpos * 3) Mod 4)
Get #1, , pix
Next
End If
Next
Case 8
palettesize = 2 ^ colornum
For i = 0 To palettesize - 1
For j = 0 To 2
Get #1, , palentry
rgbpalette(i, j) = palentry
Next
Get #1, , palentry
unused = palentry
If unused <> 0 Then
GoTo readend
End If
Next
readend:
For i = 0 To ypos - 1
For j = 0 To xpos - 1
Get #1, , index
piccol(j, i, 0) = rgbpalette(index, 0)
piccol(j, i, 1) = rgbpalette(index, 1)
piccol(j, i, 2) = rgbpalette(index, 2)
Next
If Int(xpos / 4) <> xpos / 4 Then
For kk = 1 To 4 - xpos Mod 4
Get #1, , pix
Next
End If
Next
End Select
Close #1
Screen.MousePointer = 0
For i = 0 To ypos - 1
For j = 0 To xpos - 1
r = piccol(j, i, 0)
g = piccol(j, i, 1)
b = piccol(j, i, 2)
c = Int((r + g + b) / 3)
If (c < intTop) And (c > intLow) Then
c = 255
Else
c = c / 2
End If
picP.PSet (j, ypos - i - 1), RGB(c, c, c)
Next j
Next i
funReadBMPByBin = True
Exit Function
errFun:
End Function
我发一个很烂的...
Module.bas
Option Explicit
Type BITMAPFILEHEADER
bfType(0 To 1) As Byte
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
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 Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Public bmpFileHeader As BITMAPFILEHEADER
Public bmpInfoHeader As BITMAPINFOHEADER
Public LeastDataSizePerLine As Long
Public DataSizePerLine As Long
Public B() As Byte
Public Sub ReadBMPStructInfo()
With bmpFileHeader
.bfType(0) = B(64)
.bfType(1) = B(65)
.bfSize = B(67) * 16 ^ 2 + B(66)
.bfReserved1 = 0
.bfReserved2 = 0
.bfOffBits = B(77) * 16 ^ 6 + B(76) * 16 ^ 4 + B(75) * 16 ^ 2 + B(74)
End With
With bmpInfoHeader
.biSize = B(81) * 16 ^ 6 + B(80) * 16 ^ 4 + B(79) * 16 ^ 2 + B(78)
.biWidth = B(85) * 16 ^ 6 + B(84) * 16 ^ 4 + B(83) * 16 ^ 2 + B(82)
.biHeight = B(89) * 16 ^ 6 + B(88) * 16 ^ 4 + B(87) * 16 ^ 2 + B(86)
'.biPlanes=1
.biBitCount = B(93) * 16 ^ 2 + B(92)
'.biCompression=
.biSizeImage = B(101) * 16 ^ 6 + B(100) * 16 ^ 4 + B(99) * 16 ^ 2 + B(98)
'.biXPelsPerMeter=
'.biYPelsPerMeter=
'.biClrUsed=
'.biClrImportant=
End With
End Sub
Form1.frm
Option Explicit
Private PBag As New PropertyBag
Private ImageIndex As Integer
Private i As Long
Private x As Long
Private y As Long
Private boolArray() As Boolean
Private boolArray_Ectype1() As Boolean
Private boolArray_Ectype2() As Boolean
Private Sub Command1_Click()
If ImageIndex < File1.ListCount - 1 Then
Picture2.Picture = LoadPicture(File1.Path & "\" & File1.List(ImageIndex))
Else
MsgBox "图片识别完毕!"
Exit Sub
End If
ImageIndex = ImageIndex + 1
SavePicture Picture2.Picture, Environ("Temp") & "\temp.bmp"
Picture2.Picture = LoadPicture(Environ("Temp") & "\temp.bmp")
Set PBag = Nothing
PBag.WriteProperty "BitMapData", Picture2.Picture
B() = PBag.Contents
Call ReadBMPStructInfo
If bmpFileHeader.bfType(0) <> 66 Or bmpFileHeader.bfType(1) <> 77 Then
MsgBox "It's not bitmap"
Exit Sub
End If
If UBound(B) - bmpFileHeader.bfSize - 2 <> 63 Then MsgBox "The property of picture is unknow": Exit Sub
If bmpFileHeader.bfOffBits + 64 <> bmpInfoHeader.biSize + 78 Or _
UBound(B) - bmpInfoHeader.biSizeImage - 2 + 1 <> bmpInfoHeader.biSize + 78 Then
MsgBox "The data array is not correct"
Exit Sub
End If
ReDim boolArray(1 To bmpInfoHeader.biWidth, 1 To bmpInfoHeader.biHeight)
ReDim boolArray_Ectype1(1 To bmpInfoHeader.biWidth, 1 To bmpInfoHeader.biHeight)
LeastDataSizePerLine = (bmpInfoHeader.biWidth * bmpInfoHeader.biBitCount + 7) \ 8
DataSizePerLine = ((bmpInfoHeader.biWidth * bmpInfoHeader.biBitCount + 31) \ 32) * 4
'Picture1.Scale (0, -Picture1.ScaleHeight)-(Picture1.ScaleWidth, 0)
i = bmpFileHeader.bfOffBits + 64
x = 1
y = 1
Picture1.Width = Picture2.Width
Picture1.Height = Picture2.Height
Do Until i >= UBound(B) - 2
If B(i) > 160 And B(i + 2) > 160 And B(i + 1) > 160 Then
B(i) = 255: B(i + 2) = 255: B(i + 1) = 255
boolArray_Ectype1(x, bmpInfoHeader.biHeight - y + 1) = False
Else
B(i) = 0: B(i + 2) = 0: B(i + 1) = 0
boolArray_Ectype1(x, bmpInfoHeader.biHeight - y + 1) = True
End If
'Picture1.PSet (x, Picture1.ScaleHeight - y), RGB(B(i), B(i + 2), B(i + 1))
'Picture1.Refresh
i = i + 3
If (i - bmpFileHeader.bfOffBits - 64 + 1) Mod DataSizePerLine = LeastDataSizePerLine + 1 Then
x = 1
y = y + 1
i = i + 2
Else
x = x + 1
End If
DoEvents
Loop
'这里的代码不得公布...呵呵
'……………………
'……………………
PBag.Contents = B()
Picture1.Picture = PBag.ReadProperty("BitMapData")
MsgBox "do"
Picture1.Cls
For x = 1 To bmpInfoHeader.biWidth
For y = 1 To bmpInfoHeader.biHeight
If boolArray(x, y) Then Picture1.PSet (x, y), vbBlack Else Picture1.PSet (x, y), vbWhite
Next y
Next x
End Sub
补充:VB , API