【VBA×画像処理】ビットマップ(BMP)画像の読み込みと書き出し

本ページではこれからVBAで画像処理を行う上で、最も重要な画像編集の対象となる画像ファイルの読み込みと、画像処理後のデータを画像ファイルとして出力する処理について解説していきます。今後の画像処理の実装はすべて、本ページで実装するclsBitmapというクラスに追記していくかたちでの実装となるためクラスモジュールの準備はここで済ませておいてください。
 

BMP画像のファイル構造

ビットマップは大きく分けると「ヘッダー部」「データ部」の2つで構成されています。このとき、バイナリデータの先頭から54byte分のデータがヘッダー部となっており、ヘッダー部以降の全てのデータがデータ部となっています。ヘッダー部にはこのファイルがビットマップであることや、画像の高さや幅、色数などの情報が格納され、データ部には各ピクセルのRGB値が順に格納されています。

 
icon-edit ヘッダー部

VBAでヘッダー部を定義するためにはBITMAPFILEHEADER構造体およびBITMAPINFOHEADER構造体を用意します。Openステートメントの「For Binary」で開いたファイルにこれら構造体を書き込めばビットマップファイルのヘッダー部の定義ができます。(※上画像でいうHeaderとInfoHeader)

'Bitmapファイルヘッダ構造体
Private Type BITMAPFILEHEADER
    bfType As String * 2        'ファイルタイプ ("BM")
    bfSize As Long              'ファイル全体のサイズ(ヘッダー部サイズ+データ部サイズ)
    bfReserved1 As Integer      '予約領域(※常に0)
    bfReserved2 As Integer      '予約領域(※常に0)
    bfOffBits As Long           'データ部の開始位置(ヘッダ部サイズ=54)
End Type

'Bitmap情報ヘッダ構造体
Private Type BITMAPINFOHEADER
    biSize As Long              'この構造体のサイズ
    biWidth As Long             '画像の幅
    biHeight As Long            '画像の高さ
    biPlanes As Integer         '平面数 (※常に1)
    biBitCount As Integer       'ピクセルあたりのビット数(色深度)
    biCompression As Long       '圧縮形式
    biSizeImage As Long         '圧縮画像データサイズ
    biXPelsPerMeter As Long     '水平方向の解像度
    biYPelsPerMeter As Long     '垂直方向の解像度
    biClrUsed As Long           '使用される色数
    biClrImportant As Long      '重要な色数 (基本は0)
End Type

 
icon-edit データ部

VBAでデータ部を定義するためにRGBTRIPLE構造体を用意します。Openステートメントの「For Binary」で開いたファイルに対して前項のヘッダー情報を書き込んだ後にこの構造体の配列を入力することで、ビットマップファイルのデータ部の定義ができます。(※上画像でいうColorTable)

'色情報
Private Type RGBTRIPLE
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
End Type

データ部の色情報は画像の上下が反転されるため、ファイル書き込み時には注意する必要があります。また、画像の各行のRGBデータは4byteの倍数(32ビットの境界)とする必要があります。たとえば 画像幅が5ピクセルの場合は15byte(=RGBの3byte×5ピクセル)となりますがこれは4の倍数に1byte分不足しているため、その部分には空の1Byteデータを入力して境界を調整する必要があります。これを行わないとピクセル情報に"ズレ"が発生してしまい正しくビットマップを表現することができません 
 

ビットマップ画像クラス

下記はBMPファイルの読み書きを行うためのコードです。名称は「clsBitmap」としてクラスモジュールとして作成してください。今後の画像処理コードはこのクラスに追加していきます。

クラスモジュール (clsBitmap)

'/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
'/_/
'/_/
'/_/
'/_/     ビットマップ画像クラス
'/_/
'/_/
'/_/
'/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

Option Explicit
'===========================================================================
'   構造体
'===========================================================================
'Bitmapファイルヘッダ構造体
Private Type BITMAPFILEHEADER
    bfType As String * 2        'ファイルタイプ ("BM")
    bfSize As Long              'ファイル全体のサイズ(ヘッダー部サイズ+データ部サイズ)
    bfReserved1 As Integer      '予約領域(※常に0)
    bfReserved2 As Integer      '予約領域(※常に0)
    bfOffBits As Long           'データ部の開始位置(ヘッダ部サイズ=54)
End Type

'Bitmap情報ヘッダ構造体
Private Type BITMAPINFOHEADER
    biSize As Long              'この構造体のサイズ
    biWidth As Long             '画像の幅
    biHeight As Long            '画像の高さ
    biPlanes As Integer         '平面数 (※常に1)
    biBitCount As Integer       'ピクセルあたりのビット数(色深度)
    biCompression As Long       '圧縮形式
    biSizeImage As Long         '圧縮画像データサイズ
    biXPelsPerMeter As Long     '水平方向の解像度
    biYPelsPerMeter As Long     '垂直方向の解像度
    biClrUsed As Long           '使用される色数
    biClrImportant As Long      '重要な色数 (基本は0)
End Type

'RGB構造体
Private Type RGBTRIPLE
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
End Type

'===========================================================================
'=  メンバ変数
'===========================================================================
Private m_rgbImageData() As RGBTRIPLE 'RGBデータ(2次元配列)
Private m_lImageHeight As Long
Private m_lImageWidth As Long

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+  プロパティ
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Get --- (Reas Only)
Property Get Height() As Long:
    Height = m_lImageHeight
End Property
Property Get Width() As Long
    Width = m_lImageWidth
End Property


'****************************************************************************
'   Bitmap画像ファイルからRGBデータを取得する
'****************************************************************************
Public Sub LoadBitmap(sPathBmpFile As String)

    'メンバ変数としてRGBデータを保存
    m_rgbImageData = ImportDataFromBitmapFile(sPathBmpFile)
    
    m_lImageHeight = GetBitmapHeight(sPathBmpFile)
    m_lImageWidth = GetBitmapWidth(sPathBmpFile)
    
End Sub
'----------------------------------------------------------------------------
'   RGBデータを取得する
'----------------------------------------------------------------------------
Private Function ImportDataFromBitmapFile(ByVal sPathBmpFile As String) As RGBTRIPLE()

    Dim bDataBmp() As Byte
    Dim rgbData() As RGBTRIPLE
    Dim rgbDataInv() As RGBTRIPLE '上下反転画像RGBデータ
    
    Dim lBuf  As Long
    Dim lHeight As Long
    Dim lWidth As Long
    Dim lFileNum As Long
    Dim lIndex As Long
    Dim lX As Long
    Dim lY As Long

    'BMP画像をバイナリデータで取得
    ReDim bDataBmp(FileLen(sPathBmpFile) - 1)
    lFileNum = FreeFile
    Open sPathBmpFile For Binary As #lFileNum
    Get #lFileNum, , bDataBmp
    Close #lFileNum

    'バイナリデータから画像の縦横サイズを取得
    lWidth = bDataBmp(18) + (bDataBmp(19) * 256) + (bDataBmp(20) * 256) + (bDataBmp(21) * 256)
    lHeight = bDataBmp(22) + (bDataBmp(23) * 256) + (bDataBmp(24) * 256) + (bDataBmp(25) * 256)

    '/*-------------------------------------------
    '/* BMP画像バイナリデータからRGB情報を取得
    '/* (バイナリデータ54番目以降がRGBデータ)
    '/*-------------------------------------------
    ReDim rgbData(0 To lHeight - 1, 0 To lWidth - 1)

    '4バイトに調整するために追加されている空のメモリサイズを取得
    lBuf = (UBound(bDataBmp) - (lWidth * lHeight * 3) - 54) / lHeight

    lIndex = 54
    For lX = 0 To lHeight - 1
        For lY = 0 To lWidth - 1
            rgbData(lX, lY).rgbRed = bDataBmp(lIndex + 2)   'R値
            rgbData(lX, lY).rgbGreen = bDataBmp(lIndex + 1) 'G値
            rgbData(lX, lY).rgbBlue = bDataBmp(lIndex)      'B値
            lIndex = lIndex + 3
        Next
        lIndex = lIndex + lBuf '空メモリ分は飛ばす
    Next
    
    '配列サイズを定義(元画像と同じ2次元配列)
    ReDim rgbDataInv(UBound(rgbData, 1), UBound(rgbData, 2))

    '上下反転
    For lY = 0 To lHeight - 1
        For lX = 0 To lWidth - 1
            rgbDataInv(lY, lX).rgbRed = rgbData((lHeight - 1) - lY, lX).rgbRed
            rgbDataInv(lY, lX).rgbGreen = rgbData((lHeight - 1) - lY, lX).rgbGreen
            rgbDataInv(lY, lX).rgbBlue = rgbData((lHeight - 1) - lY, lX).rgbBlue
         Next
    Next
    
    ImportDataFromBitmapFile = rgbDataInv

End Function
'----------------------------------------------------------------------------
'   BMP画像の高さを取得
'----------------------------------------------------------------------------
Private Function GetBitmapHeight(sPathBmpFile As String) As Long

    Dim bDataBmp()  As Byte
    Dim lFileNum    As Long

    'BMP画像をバイナリデータで取得
    ReDim bDataBmp(FileLen(sPathBmpFile) - 1)
    lFileNum = FreeFile
    Open sPathBmpFile For Binary As #lFileNum
    Get #lFileNum, , bDataBmp
    Close #lFileNum

    'バイナリデータから画像の縦横サイズを取得
    GetBitmapHeight = bDataBmp(22) + (bDataBmp(23) * 256) + (bDataBmp(24) * 256) + (bDataBmp(25) * 256)
    
End Function
'----------------------------------------------------------------------------
'   BMP画像の幅を取得
'----------------------------------------------------------------------------
Private Function GetBitmapWidth(sPathBmpFile As String) As Long

    Dim bDataBmp()  As Byte
    Dim lFileNum    As Long

    'BMP画像をバイナリデータで取得
    ReDim bDataBmp(FileLen(sPathBmpFile) - 1)
    lFileNum = FreeFile
    Open sPathBmpFile For Binary As #lFileNum
    Get #lFileNum, , bDataBmp
    Close #lFileNum

    'バイナリデータから画像の縦横サイズを取得
    GetBitmapWidth = bDataBmp(18) + (bDataBmp(19) * 256) + (bDataBmp(20) * 256) + (bDataBmp(21) * 256)

End Function

'****************************************************************************
'*  画像(24bit)ファイルとして出力する
'****************************************************************************
Public Sub ExportBitmap24(ByVal sPathFile As String)

    Dim bfHeader As BITMAPFILEHEADER
    Dim biHeader As BITMAPINFOHEADER
    Dim lHeight As Long
    Dim lWidth As Long

    Dim bBuf As Byte
    Dim lFileNum As Long
    Dim i As Long
    Dim j As Long
    Dim n As Long
    
    lHeight = UBound(m_rgbImageData, 1) + 1  '配列は0始まりなので+1で補正
    lWidth = UBound(m_rgbImageData, 2) + 1   '            〃
    
    'Bitmapの横幅は4byte単位になるように足りない分は0で埋める必要あり
    '横幅の値から何px分0で埋める必要があるかを算出
    n = (4 - (lWidth * 3 Mod 4)) Mod 4
    
    'Bitmapファイルヘッダ設定
    With bfHeader
        .bfType = "BM"
        .bfSize = Len(bfHeader) + Len(biHeader) + 3 * lHeight * lWidth
        .bfReserved1 = 0
        .bfReserved2 = 0
        .bfOffBits = Len(bfHeader) + Len(biHeader)
    End With
    
    'Bitmap情報ヘッダ設定
    With biHeader
        .biSize = 40
        .biWidth = lWidth
        .biHeight = lHeight
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = 0
        .biSizeImage = 3 * lHeight * lWidth
        .biXPelsPerMeter = 3780
        .biYPelsPerMeter = 3780
        .biClrUsed = 0
        .biClrImportant = 0
    End With
    
    'ファイルが既に存在している場合は削除
    If Len(Dir(sPathFile)) Then Kill sPathFile

    lFileNum = FreeFile()
    Open sPathFile For Binary As #lFileNum
        
        'ヘッダ情報書き込み
        Put #lFileNum, , bfHeader
        Put #lFileNum, , biHeader
        
        'RGB値書き込み(BGRの順番)
        For i = lHeight - 1 To 0 Step -1
            For j = 0 To lWidth - 1
                Put #lFileNum, , m_rgbImageData(i, j)
            Next
            For j = 1 To n
                Put #lFileNum, , bBuf
            Next
        Next
    Close #lFileNum
    
End Sub


'------------------------------------------------------------------------------
'
'
'        m_rgbImageDataの中身を更新する画像処理コードを追加
'
'
'------------------------------------------------------------------------------

  
 標準モジュール

Option Explicit
Sub main()

    Dim sPathBmpSrc As String
    Dim sPathBmpExport As String
    Dim oBitmap As clsBitmap
    
    sPathBmpSrc = "C:\...\source.bmp"
    sPathBmpExport = "C:\...\output.bmp"
    
    Set oBitmap = New clsBitmap
    Call oBitmap.LoadBitmap(sPathBmpSrc)
    Call oBitmap.ExportBitmap24(sPathBmpExport)

End Sub

標準モジュールはclsBitmapを呼び出して画像を読み込ませたり出力させたりする処理を記載します。

上記の標準モジュールコードでは、LoadBitmap関数でclsBitmap内の配列にBMP画像データを読み込ませ、ExportBitmap24関数でclsBitmap内の配列をBMPファイルとして出力しています。もちろん読み込んだデータをそのまま出力しているため、入力と出力の結果に違いはないです。

読み込んだBMP画像データは2次元配列データのためこの配列内の要素を編集することで、出力される画像にもその変更を反映させることができます。たとえば、各要素のRGB値を取得して閾値判定を行い、白または黒に分ける処理を加えることで、画像を二値化データへ変換できます。さらに、その変換後の配列データをBMPファイルとして出力すれば、白黒画像として保存することが可能です。

つまり本クラスでは LoadBitmap 関数で画像データを読み込んだ後、ExportBitmap24 関数で出力するまでの間に、クラス内配列に保持されているRGBデータを自由に操作できます。この仕組みにより、任意の画像処理をクラス内で実現できるわけです。(画像処理の実装はメインページを参照ください)

 

画像ファイルの読み込み

前述の通り、BMPファイルはOpenステートメントの「For Binary」で読み込むことでByte型の1次元配列としてデータを取得することができます。下記は入力されたBMP画像ファイルパスからRGBデータ部分を抽出し、RGBTRIPLE型の2次元配列として返す関数です。2次元配列に変換しておくことで、左上のピクセル=(0,0)要素というように座標的にもアクセスがしやすく画像処理時にも便利です。

Private Function ImportDataFromBitmapFile(ByVal sPathBmpFile As String) As RGBTRIPLE()

    Dim bDataBmp() As Byte
    Dim rgbData() As RGBTRIPLE
    Dim rgbDataInv() As RGBTRIPLE '上下反転画像RGBデータ
    
    Dim lBuf  As Long
    Dim lHeight As Long
    Dim lWidth As Long
    Dim lFileNum As Long
    Dim lIndex As Long
    Dim lX As Long
    Dim lY As Long

    'BMP画像をバイナリデータで取得
    ReDim bDataBmp(FileLen(sPathBmpFile) - 1)
    lFileNum = FreeFile
    Open sPathBmpFile For Binary As #lFileNum
    Get #lFileNum, , bDataBmp
    Close #lFileNum

    'バイナリデータから画像の縦横サイズを取得
    lWidth = bDataBmp(18) + (bDataBmp(19) * 256) + (bDataBmp(20) * 256) + (bDataBmp(21) * 256)
    lHeight = bDataBmp(22) + (bDataBmp(23) * 256) + (bDataBmp(24) * 256) + (bDataBmp(25) * 256)

    '/*-------------------------------------------
    '/* BMP画像バイナリデータからRGB情報を取得
    '/* (バイナリデータ54番目以降がRGBデータ)
    '/*-------------------------------------------
    ReDim rgbData(0 To lHeight - 1, 0 To lWidth - 1)

    '4バイトに調整するために追加されている空のメモリサイズを取得
    lBuf = (UBound(bDataBmp) - (lWidth * lHeight * 3) - 54) / lHeight

    lIndex = 54
    For lX = 0 To lHeight - 1
        For lY = 0 To lWidth - 1
            rgbData(lX, lY).rgbRed = bDataBmp(lIndex + 2)   'R値
            rgbData(lX, lY).rgbGreen = bDataBmp(lIndex + 1) 'G値
            rgbData(lX, lY).rgbBlue = bDataBmp(lIndex)      'B値
            lIndex = lIndex + 3
        Next
        lIndex = lIndex + lBuf '空メモリ分は飛ばす
    Next
    
    '配列サイズを定義(元画像と同じ2次元配列)
    ReDim rgbDataInv(UBound(rgbData, 1), UBound(rgbData, 2))

    '上下反転
    For lY = 0 To lHeight - 1
        For lX = 0 To lWidth - 1
            rgbDataInv(lY, lX).rgbRed = rgbData((lHeight - 1) - lY, lX).rgbRed
            rgbDataInv(lY, lX).rgbGreen = rgbData((lHeight - 1) - lY, lX).rgbGreen
            rgbDataInv(lY, lX).rgbBlue = rgbData((lHeight - 1) - lY, lX).rgbBlue
         Next
    Next
    
    ImportDataFromBitmapFile = rgbDataInv

End Function

Byte型の1次元配列で取得したデータは、0~53番目までの計54byte分の要素はヘッダー部を表しており、それ以降の全ての要素がデータ部を表しています。RGB値を2次元配列に変換する際、単純に2次元配列化するだけだと画像の上下が反転したり、画像サイズによってはピクセル情報にズレが出るなどの問題があるため、上記コードのようにこれら問題を考慮して、画像の向きを整えつつ確実にRGB値のみを抽出して2次元配列化する処理が必要になります。
 

画像ファイルの書き出し

前項でBMPファイルを2次元配列として読み込むことができました。画像処理としてはこの2次元配列に何らかの処理(二値化やネガポジ反転など)が施されます。画像処理後の配列データも読み込み時と同様に2次元配列であり、ただの数値データのままなので画像ファイルとして出力する必要があります。

出力処理の考え方は読み込み時とほとんど同じです。はじめにヘッダーの情報を設定して各ピクセル情報を追加していくだけです。注意点も読み込み時と同じです。

Public Sub ExportBitmap24(ByVal sPathFile As String)

    Dim bfHeader As BITMAPFILEHEADER
    Dim biHeader As BITMAPINFOHEADER
    Dim lHeight As Long
    Dim lWidth As Long

    Dim bBuf As Byte
    Dim lFileNum As Long
    Dim i As Long
    Dim j As Long
    Dim n As Long
    
    lHeight = UBound(m_rgbImageData, 1) + 1  '配列は0始まりなので+1で補正
    lWidth = UBound(m_rgbImageData, 2) + 1   '            〃
    
    'Bitmapの横幅は4byte単位になるように足りない分は0で埋める必要あり
    '横幅の値から何px分0で埋める必要があるかを算出
    n = (4 - (lWidth * 3 Mod 4)) Mod 4
    
    'Bitmapファイルヘッダ設定
    With bfHeader
        .bfType = "BM"
        .bfSize = Len(bfHeader) + Len(biHeader) + 3 * lHeight * lWidth
        .bfReserved1 = 0
        .bfReserved2 = 0
        .bjOffBits = Len(bfHeader) + Len(biHeader)
    End With
    
    'Bitmap情報ヘッダ設定
    With biHeader
        .biSize = 40
        .biWidth = lWidth
        .biHeight = lHeight
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = 0
        .biSizeImaze = 3 * lHeight * lWidth
        .biXPixPerMeter = 3780
        .biYPixPerMeter = 3780
        .biClrUsed = 0
        .biClrImporant = 0
    End With
    
    'ファイルが既に存在している場合は削除
    If Len(Dir(sPathFile)) Then Kill sPathFile

    lFileNum = FreeFile()
    Open sPathFile For Binary As #lFileNum
        
        'ヘッダ情報書き込み
        Put #lFileNum, , bfHeader
        Put #lFileNum, , biHeader
        
        'RGB値書き込み(BGRの順番)
        For i = lHeight - 1 To 0 Step -1
            For j = 0 To lWidth - 1
                Put #lFileNum, , m_rgbImageData(i, j)
            Next
            For j = 1 To n
                Put #lFileNum, , bBuf
            Next
        Next
    Close #lFileNum
    
End Sub

ここでは汎用的でフルカラー対応の24bitのビットマップファイルとして出力していますが、他のbit数での出力をする場合はヘッダーの構造などが変化するため本コードでは出力できません。基本的に大まかな考え方は同じなので興味のある方は別途調べてみてください。

関連情報

 VBA×画像処理ページ

次回 >> 画像のグレースケール化
画像処理のメインページへ戻る

 参考

外部リンク:ビットマップの種類 – Windows Forms

Excel,VBA,画像処理