+ -
当前位置:首页 → 问答吧 → 数字图像处理老是读不出来图像文件,直的搞了好长时间了,求救啊???

数字图像处理老是读不出来图像文件,直的搞了好长时间了,求救啊???

时间:2011-09-28

来源:互联网

Dim i, j, w, h As Long
Dim bc As Long
Dim b1, b2 As Integer
Dim pic(2000, 2000, 2) As Byte
Dim pix As Byte
Private Sub Command1_Click()
CommonDialog1.DialogTitle = "OPEN"
CommonDialog1.Filter = ".bmp"
CommonDialog1.ShowOpen
End Sub

Private Sub Command2_Click()
Open CommonDialog1.FileName For Binary As #1
  Get #1, 1, b1
  Get #1, 2, b2
  Text1.Text = b1
  Text2.Text = b2
  If b1 = 66 And b2 = 77 Then
  Get #1, 29, bc
  Text3.Text = bc
  If bc = 24 Then
  Get #1, 19, w
  Get #1, 23, h
  Seek #1, 55
  For j = h - 1 To 0 Step -1
  For i = 0 To w - 1
  For k = 2 To 0 Step -1
  Get #1, , pic(i, j, k)
  Next k
  Next i
  If (w * 3) Mod 4 <> 0 Then
  For k = 1 To 4 - ((w * 3) Mod 4)
  Get #1, , pix
  Next k
  End If
  Next j
   
  For j = 0 To h - 1
  For i = 0 To w - 1
  Picture1.PSet (i, j), RGB(pic(i, j, 0), pic(i, j, 1), pic(i, j, 2))
  Next i
  Next j
  End If
  End If
  Close #1
End Sub

作者: abcd19921007   发布时间: 2011-09-28

参阅一下这个:
VB code

'Option Explicit
'头文件
Private Type bitmapfileheader
    bftype As Integer
    bfsize As Long
    bfreserved1 As Integer
    bfreserved2 As Integer
bfoffbits As Long
End Type
'头信息
Private 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
Dim bf As bitmapfileheader
Dim bl As bitmapinfoheader
Dim xpos As Long
Dim ypos As Long
Dim picturename As String
Dim piccol(1024, 1024, 2) As Byte
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'过程功能:载入图像
'功能描述:
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub Command1_Click()
    Dim colornum, i, j, kk, l As Integer
    Dim pix As Byte
    Dim col As Byte
    Dim index As Byte
    Dim palentry As Byte
    Dim unused As Integer
    Dim rgbpalette(256, 3) As Byte
    Dim palettesize As Integer
On Error GoTo errSub
    CommonDialog1.DialogTitle = "打开文件"
    CommonDialog1.InitDir = App.Path & "\BMP"
    CommonDialog1.ShowOpen
    If CommonDialog1.filename = "" Then
        MsgBox "请先打开图像文件,再读入数据!", vbCritical, "错误"
        Exit Sub
    End If
    Picture1.Picture = LoadPicture(CommonDialog1.filename)
    
    Open CommonDialog1.filename For Binary As #1
    Get #1, , bf
    Get #1, , bl
    Print bf.bftype
    Print bf.bfreserved1
    Print bl.biwidth
    Print bl.biheight
    Print bl.bixpelspermeter
    
    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
    Exit Sub
errSub:

End Sub

作者: Veron_04   发布时间: 2011-09-28

楼主这样也太蛮干了, 文件有数据结构滴
看看1楼的结构定义和读取方法.

作者: WallesCai   发布时间: 2011-09-28

热门下载

更多