当前位置:编程学习 > VB >>

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
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,