CODEWITHSUNDEEP
excelvbaimagebitmappixel
am2
am2

Reputation: 371

how to read pixels from a picture- file with excel vba?

does anybody know, how to read each pixel of a bitmap file?
I want to write the r/g/b- values into Excel-sheets.

I look for something like

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

Upvotes: 0

Views: 7411

Answers (1)

Alex Lelekov
Alex Lelekov

Reputation: 61

I think that the code should look something like this (BMP, 24-bit RGB color, no color space info):

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

I could not find ready-made solutions, IMHO for another type of files you need to write the code yourself

Upvotes: 3

Related Questions