Count # of pixels in BMP file

[seraslibre]

I'm trying to analyze a BMP image to determine area information based on pixel color:

e.g.: Count the number of pixels within the following range:
1. 51% grey to black
2. white to 50% grey

Could I do this with VBA? I am assuming it is better to work with a BMP file, but is it better to work with an alternate format?

Thanks in advance!

 

[Andrew Fergus]

Hi

This can definitely be done, because I have worked with something very similar before. Are you working with 24 bit bmp files?

To find out, copy this code into a spreadsheet macro, run the 'Main' sub-routine, you will be prompted for a bmp file and post back with the bitsize. It's much easier if it's 24.

Andrew

Option Explicit

Private Type PTbmpFileHeader
    bmpType As String * 2
    bmpSize As Long
    bmpRes1 As Integer
    bmpRes2 As Integer
    bmpOffBits As Long
End Type

Private Type PTbmpTypeInfoHeader
    bmpSize As Long
    bmpWidth As Long
    bmpHeight As Long
    bmpPlanes As Integer
    bmpBits As Integer
    bmpCompression As Long
    bmpImageSize As Long
    bmpxRes As Long
    bmpyRes As Long
    bmpColours As Long
    bmpImptColors As Long
End Type

Dim MyFile As String
        
Sub Main()

Dim flNum As Integer
Dim bmpFileHeader As PTbmpFileHeader
Dim bmpInfoHeader As PTbmpTypeInfoHeader

If GetFile = False Then Exit Sub

flNum = FreeFile()

    Open MyFile For Binary Access Read As flNum

    Get flNum, 1, bmpFileHeader
    
    Get flNum, , bmpInfoHeader
    
    MsgBox "Bitsize = " & bmpInfoHeader.bmpBits
    
Close flNum

End Sub


Function GetFile() As Boolean

Dim fd As FileDialog, vrtSelectedItem As Variant

GetFile = False
 
Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
With fd
    .AllowMultiSelect = False
    .Title = "Please select the bitmpap file."
    .Filters.Add "Bitmap files", "*.bmp", 1
 
    If .Show = -1 Then
        MyFile = .SelectedItems(1)
        GetFile = True
    End If
End With

End Function