请教，怎么把一张图片每个点的像素保存为一个数组

2013-11-09

请问，如何把一张图片每个点的像素保存为一个数组？RT,Point的方式太慢了，有没有其他办法能快速的保存呢？[解

请问，如何把一张图片每个点的像素保存为一个数组？
RT,Point的方式太慢了，有没有其他办法能快速的保存呢？
[解决办法]


Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Private Sub Command1_Click()
    Dim lpBits() As Byte
    Dim hBitmap, dwCount As Long, i As Long
    Dim nWidth As Long, nHeight As Long
    
    '以下代码取图像的像素数组，每3个字节表示一个像素
    hBitmap = Me.Picture1.Picture.Handle
    dwCount = GetBitmapBits(hBitmap, 0, ByVal 0&)
    ReDim lpBits(dwCount - 1)
    GetBitmapBits hBitmap, dwCount, lpBits(0)
    
    '以下代码把图像中的第二行的前50个像素的颜色设为红色
    nWidth = Me.ScaleX(Me.Picture1.Picture.Width, vbHimetric, vbPixels)
    For i = nWidth * 3 - 1 To nWidth * 3 + 50 Step 3
        lpBits(i) = 255
        lpBits(i + 1) = 0
        lpBits(i + 2) = 0
    Next
    SetBitmapBits hBitmap, dwCount, lpBits(0)
    Me.Picture1.Refresh
End Sub

[解决办法]
jpg等picture能显示的图我一般用picture控件读入再GetBitmapBits
png比较麻烦了，要么加转换的类要么通过webbrowser显示出来copy到picture控件里

其实你用GetBitmapBits 得到的b()就已经是图像点阵的雏形了只不过需要进行一下RGB转换
不过由b()得到的新RGB数组的第一个像素点是左上角开始的
[解决办法]
如果是bmp格式的话我这里有个直接读取的方法。

下面代码是直接将bmp图片读取并显示到picturebox中的，稍稍修改下就是你要的了。

窗体form1代码：

'添加一个picturebox1，按钮command1，防止一个bmp文件 c:\1.bmp
Option Explicit

Dim bfh As BitFileHeader
Dim colornumber As Byte, thisrgbw As rgbw, thiscolor As Long
Dim x As Long, y As Long
Dim cols As Integer, rows As Integer

Private Sub Command1_Click()
    Dim strInfo As String

    Open "c:\1.bmp" For Binary As #1
    Get #1, 1, bfh

    strInfo = "文件参数：" & vbCrLf & vbCrLf & _
                "bfsize = " & bfh.bfsize & vbCrLf & _
                "bfoffbits = " & bfh.bfoffbits & vbCrLf & _
                "biwidth = " & bfh.biwidth & vbCrLf & _
                "biheight = " & bfh.biheight & vbCrLf & _
                "调色板数 = " & bfh.biplanes & vbCrLf & _
                "颜色位数 = " & bfh.bibitcount & vbCrLf & _
                "bicompress = " & bfh.bicompress & vbCrLf & _
                "bisizeimage = " & bfh.bisizeimage & vbCrLf & _
                "bixpixelpermeter = " & bfh.bixpixelpermeter & vbCrLf & _
                "biypixelspermeter = " & bfh.biypixelspermeter & vbCrLf & _
                "bilrused = " & bfh.bilrused & vbCrLf & _
                "biclrinportant = " & bfh.biclrinportant

    MsgBox strInfo

    Picture1.Width = bfh.biwidth
    Picture1.Height = bfh.biheight
    DoEvents

    Select Case bfh.bibitcount
        Case 1
                Call deal2bmp
        Case 4
                Call deal16bmp
        Case 8
                Call deal256bmp
        Case 24
                Call deal24bitbmp
    End Select
    Close #1
End Sub
Sub deal2bmp()
    Dim i As Integer, thisbit As Integer
    cols = (bfh.biwidth + 7) \ 8 '八个点共一个字节
    cols = IIf(cols Mod 4 = 0, cols, (cols \ 4 + 1) * 4) '凑成4有倍数
    rows = bfh.biheight
    For y = 0 To rows - 1
        For x = 0 To cols - 1
            Get #1, bfh.bfoffbits + 1 + y * cols + x, colornumber
            For i = 7 To 0 Step -1
                thisbit = colornumber \ (2 ^ i) Mod 2 '滤出一个字节中的某一位作为一个点的颜色号
                Get #1, 55 + thisbit * 4, thisrgbw

                thiscolor = RGB(thisrgbw.r, thisrgbw.g, thisrgbw.b)
                If x < (bfh.biwidth + 7) \ 8 Then
                    Picture1.PSet (8 * x + 7 - i, rows - 1 - y), thiscolor
                End If
            Next i
        Next x
    Next y
End Sub

Sub deal16bmp()
    cols = (bfh.biwidth + 1) \ 2 '两个点共一个字节
    cols = IIf(cols Mod 4 = 0, cols, (cols \ 4 + 1) * 4) '凑成4有倍数
    rows = bfh.biheight
    For y = 0 To rows - 1
        For x = 0 To cols - 1
            Get #1, bfh.bfoffbits + 1 + y * cols + x, colornumber
            Get #1, 55 + (colornumber \ 16) * 4, thisrgbw '读取左4位作为第一个点的颜色号
            thiscolor = RGB(thisrgbw.r, thisrgbw.g, thisrgbw.b)
            If x < (bfh.biwidth + 1) \ 2 Then Picture1.PSet (2 * x, rows - 1 - y), thiscolor

            Get #1, 55 + (colornumber Mod 16) * 4, thisrgbw '读取右4位作为第二个点的颜色号
            thiscolor = RGB(thisrgbw.r, thisrgbw.g, thisrgbw.b)
            If x < (bfh.biwidth + 1) \ 2 Then Picture1.PSet (2 * x + 1, rows - 1 - y), thiscolor
        Next x
    Next y
End Sub

Sub deal256bmp()
    cols = IIf(bfh.biwidth Mod 4 = 0, bfh.biwidth, (bfh.biwidth \ 4 + 1) * 4) '每点占一个字节，每行字节数凑成4的倍数
    rows = bfh.biheight

    For y = 0 To rows - 1
        For x = 0 To cols - 1
            Get #1, bfh.bfoffbits + 1 + y * cols + x, colornumber
            Get #1, 55 + colornumber * 4, thisrgbw
            thiscolor = RGB(thisrgbw.r, thisrgbw.g, thisrgbw.b)
            If x < bfh.biwidth Then Picture1.PSet (x, rows - 1 - y), thiscolor
        Next x
    Next y
End Sub

Sub deal24bitbmp()
    Dim r As Byte, g As Byte, b As Byte
    cols = IIf(3 * bfh.biwidth Mod 4 = 0, 3 * bfh.biwidth, (3 * bfh.biwidth \ 4 + 1) * 4) '每点占三个字节,每行字节数凑成4的倍数
    rows = bfh.biheight
    For y = 0 To rows - 1
        For x = 0 To cols - 1
            Get #1, bfh.bfoffbits + 1 + y * cols + x, thisrgbw
            thiscolor = RGB(thisrgbw.r, thisrgbw.g, thisrgbw.b)
            If x Mod 3 = 0 And x < 3 * bfh.biwidth Then Picture1.PSet (x \ 3, rows - 1 - y), thiscolor
        Next x
    Next y
End Sub

module模块代码：

Option Explicit

Public Type BitFileHeader
    bftype As String * 2 '2
    bfsize As Long '4
    bfreserved1 As Integer '2
    bfreserved2 As Integer '2
    bfoffbits As Long '4
    bisize As Long '4
    biwidth As Long '4
    biheight As Long '4
    biplanes As Integer '2
    bibitcount As Integer '2
    bicompress As Long '4
    bisizeimage As Long '4
    bixpixelpermeter As Long '4
    biypixelspermeter As Long '4
    bilrused As Long '4
    biclrinportant As Long '4
End Type

Public Type rgbw
    b As Byte
    g As Byte
    r As Byte
    w As Byte
End Type

热点排行

VB

请教，怎么把一张图片每个点的像素保存为一个数组