2017-06-30 357 views
0

有谁知道,如何读取位图文件的每个像素?
我想将r/g/b-值写入Excel表格。如何从excel vba中读取图片文件中的像素?

我期待像

my_picture = LoadThePicture('alf.txt') 
for y = 0 to my_picture.Height() 
    for x = 0 to my_picture.Width() 
    red = my_picture.GetPixel(x,y).Red 

AM2

回答

1

我认为代码应该是这个样子(BMP,24位RGB颜色,任何色彩空间的信息):

Option Explicit 

Type typHEADER 
    strType As String * 2 ' Signature of file = "BM" 
    lngSize As Long  ' File size 
    intRes1 As Integer  ' reserved = 0 
    intRes2 As Integer  ' reserved = 0 
    lngOffset As Long  ' offset to the bitmap data (bits) 
End Type 

Type typINFOHEADER 
    lngSize As Long  ' Size 
    lngWidth As Long  ' Height 
    lngHeight As Long  ' Length 
    intPlanes As Integer ' Number of image planes in file 
    intBits As Integer  ' Number of bits per pixel 
    lngCompression As Long ' Compression type (set to zero) 
    lngImageSize As Long ' Image size (bytes, set to zero) 
    lngxResolution As Long ' Device resolution (set to zero) 
    lngyResolution As Long ' Device resolution (set to zero) 
    lngColorCount As Long ' Number of colors (set to zero for 24 bits) 
    lngImportantColors As Long ' "Important" colors (set to zero) 
End Type 

Type typBITMAPFILE 
    bmfh As typHEADER 
    bmfi As typINFOHEADER 
    bmbits() As Byte 
End Type 

Type typPicture 
    Height As Integer 
    Width As Integer 
    Red() As Byte 
    Green() As Byte 
    Blue() As Byte 
End Type 

Function LoadThePicture(bmpFileName As String) As typPicture 
    Dim bmpFile As typBITMAPFILE 
    Dim pict As typPicture 
    Open bmpFileName For Binary As #1 
    'Read_headers 
    Get #1, , bmpFile.bmfh 
    Get #1, , bmpFile.bmfi 

    Dim lngRowSize, lngPixelArraySize As Long 
    Dim Rows, Cols, pad4 As Integer 
    Rows = bmpFile.bmfi.lngHeight 
    Cols = bmpFile.bmfi.lngWidth 
    pict.Height = Rows 
    pict.Width = Cols 
    ReDim pict.Red(1 To Rows, 1 To Cols) 
    ReDim pict.Green(1 To Rows, 1 To Cols) 
    ReDim pict.Blue(1 To Rows, 1 To Cols) 

    lngRowSize = ceil(bmpFile.bmfi.intBits * bmpFile.bmfi.lngWidth/32) * 4 
    pad4 = lngRowSize - Fix(bmpFile.bmfi.intBits * bmpFile.bmfi.lngWidth/32 * 4) ' how much to pad to 4 bytes group 
    lngPixelArraySize = lngRowSize * bmpFile.bmfi.lngHeight 
    ReDim bmpFile.bmbits(1 To lngPixelArraySize) 
    Get #1, , bmpFile.bmbits 
    Close #1 

    Dim row, col, k, l As Integer 
    k = 0 
    For row = Rows To 1 Step -1 
     For col = 1 To Cols 
      pict.Blue(row, col) = bmpFile.bmbits(k + 1) 
      pict.Green(row, col) = bmpFile.bmbits(k + 2) 
      pict.Red(row, col) = bmpFile.bmbits(k + 3) 
      k = k + 3 
     Next col 
     k = k + pad4 ' skip padding 
    Next row 
End Function 

我找不到现成的解决方案,恕我直言,你需要自己写代码的另一种类型的文件