【VBA×画像処理】ビットマップ画像の二値化 (白黒/モノクロ)

本ページでは、VBAで読み込んだビットマップ（BMP）画像を内部的に処理し、各ピクセルのRGB値をもとに二値化を行う方法を解説していきます。二値化とは、画像をあらかじめ設定した閾値を基準に「黒」か「白」のどちらかに分類する処理のことをいいます。シンプルで基礎的な処理ですが、文字認識や領域抽出といった応用的な画像処理を行う際の前準備としてよく利用される重要なステップです。

注意事項

本ページではビットマップ(BMP)画像の読み込みと書き出しページで実装したクラスに画像処理を追加していきます。前提の機能となる画像の入出力機能を実装しているため事前に一読ください。

Contents

1. 二値化
2. サンプルコード
3. コード解説
4. 関連情報

二値化

二値化とは各ピクセルを「黒」か「白」のどちらかに分類する処理です。
グレースケール画像では0～255などの連続的な輝度値を持ちますが、二値化では基準となる「しきい値」を設定し、その値以上なら白、未満なら黒といった具合にピクセルを2値に変換します。

しきい値の決め方は大きく分けて「固定しきい値」と「自動しきい値」の2種類があります。

固定しきい値では、例えば256段階の中間である128を境に、0～127を黒、128～255を白とする方法があります。この場合、画像の特徴を考慮せずに一律で境界を決めるため、画像の明るさやコントラストによっては対象を適切に分離できないことがあります。

一方、自動しきい値は代表的な手法として「大津の二値化」があります。これは画像のヒストグラムを解析し、白側と黒側のクラス間分散が最大となるようなしきい値を自動的に求める手法です。背景と対象をバランスよく分離できるため、多くの画像処理で利用されています。(計算方法は後述)
ちなみに名称はこの手法の考案者である大津さんに由来します。

これら2つの手法を比較すると、下の画像のように「固定しきい値」よりも「自動しきい値」のほうが対象の輪郭や影をより自然ではっきりと分離できていることが分かります。

サンプルコード

以下は二値化を行うためのコードです。事前に用意しておいたclsBitmap内に下記コードをコピペすることで利用可能になります。処理内容は画像をグレースケール化した後、全ピクセルを走査したときのグレースケール値がしきい値より上か下で白と黒に振り分けるという単純な内容です。単純な二値化(固定しきい値)だけでなく大津の二値化(自動しきい値)の関数も用意しています。

クラスモジュール (clsBitmapに追記)

'****************************************************************************
'*  二値化
'*      (bThreshold)：閾値
'****************************************************************************
Public Sub Binarization(Optional bThreshold As Byte = 128)

    Dim rgbDataOrg()   As RGBTRIPLE '元画像RGBデータ
    Dim rgbDataBin()   As RGBTRIPLE '二値化変換後画像データ

    Dim lHeight As Long
    Dim lWidth As Long
    Dim lX As Long
    Dim lY As Long
    Dim lR As Long '┐
    Dim lG As Long '│平均値計算時のオーバーフロー回避のためLong型(本来はByte型)
    Dim lB As Long '┘
    Dim dGray As Double
    Dim bGray As Byte
    Dim bBinary As Byte

    '元画像情報を取得
    rgbDataOrg = m_rgbImageData
    lHeight = UBound(rgbDataOrg, 1) + 1  '配列は0始まりなので+1で補正
    lWidth = UBound(rgbDataOrg, 2) + 1   '配列は0始まりなので+1で補正

    '配列サイズを定義(元画像と同じ2次元配列)
    ReDim rgbDataBin(UBound(rgbDataOrg, 1), UBound(rgbDataOrg, 2))

    '二値化
    For lY = 0 To lHeight - 1
        For lX = 0 To lWidth - 1
        
            lR = rgbDataOrg(lY, lX).rgbRed
            lG = rgbDataOrg(lY, lX).rgbGreen
            lB = rgbDataOrg(lY, lX).rgbBlue
            
            'グレースケール変換 (輝度法)
            dGray = 0.2126 * lR + 0.7152 * lG + 0.0722 * lB
            bGray = CByte(dGray)
            
            '値が閾値より小さい場合は白,大きい場合は黒
            If bGray < bThreshold Then
                bBinary = 0
            Else
                bBinary = 255
            End If
        
            rgbDataBin(lY, lX).rgbRed = bBinary
            rgbDataBin(lY, lX).rgbGreen = bBinary
            rgbDataBin(lY, lX).rgbBlue = bBinary
        Next
    Next

    'RGBデータを更新
    m_rgbImageData = rgbDataBin

End Sub
'****************************************************************************
'*  大津の二値化
'****************************************************************************
Public Sub BinarizationOtsu()

    Dim rgbDataOrg()   As RGBTRIPLE '元画像RGBデータ
    Dim rgbDataBin()   As RGBTRIPLE '二値化変換後画像データ
    Dim bGrayData()    As Byte      'グレー値を保持して再利用

    Dim lHeight As Long
    Dim lWidth As Long
    Dim lX As Long
    Dim lY As Long
    Dim lR As Long '┐
    Dim lG As Long '│平均値計算時のオーバーフロー回避のためLong型(本来はByte型)
    Dim lB As Long '┘
    Dim dGray As Double
    Dim bGray As Byte
    Dim lHistogram(0 To 255) As Long    'グレーレベルヒストグラム
    Dim t As Long
    Dim lTotalPixels As Long
    Dim lSumAll As Double
    Dim dWeightwBack As Double          '背景(白)の画素数累積
    Dim dWeightwFront As Double         '前景(黒)の画素数累積
    Dim dSumBack As Double              '背景側の濃度総和累積
    Dim dMeanBack As Double
    Dim dMeanFront As Double
    Dim dBetweenClassVari As Double     'クラス間分散
    Dim dMaxBetweenClassVari As Double  '最大クラス間分散
    Dim lBestThreshold  As Long         '最適なしきい値

    '元画像情報を取得
    rgbDataOrg = m_rgbImageData
    lHeight = UBound(rgbDataOrg, 1) + 1
    lWidth = UBound(rgbDataOrg, 2) + 1
    lTotalPixels = lWidth * lHeight

    'ヒストグラム作成（Grayを保存）
    ReDim bGrayData(lHeight - 1, lWidth - 1)
    lSumAll = 0#
    For lY = 0 To lHeight - 1
        For lX = 0 To lWidth - 1
            lR = rgbDataOrg(lY, lX).rgbRed
            lG = rgbDataOrg(lY, lX).rgbGreen
            lB = rgbDataOrg(lY, lX).rgbBlue

            dGray = 0.2126 * lR + 0.7152 * lG + 0.0722 * lB
            If dGray < 0 Then
                dGray = 0
            ElseIf dGray > 255 Then
                dGray = 255
            End If
            bGray = CByte(dGray)

            bGrayData(lY, lX) = bGray
            lHistogram(bGray) = lHistogram(bGray) + 1
            lSumAll = lSumAll + bGray
        Next
    Next

    '最適なしきい値の計算
    dSumBack = 0
    dWeightwBack = 0
    dMaxBetweenClassVari = -1
    lBestThreshold = 0
    For t = 0 To 255
        dWeightwBack = dWeightwBack + lHistogram(t)
        If dWeightwBack = 0 Then GoTo NextThreshold

        dWeightwFront = lTotalPixels - dWeightwBack
        If dWeightwFront = 0 Then Exit For

        dSumBack = dSumBack + CDbl(t) * CDbl(lHistogram(t))
        dMeanBack = dSumBack / dWeightwBack
        dMeanFront = (lSumAll - dSumBack) / dWeightwFront

        dBetweenClassVari = dWeightwBack * dWeightwFront * (dMeanBack - dMeanFront) * (dMeanBack - dMeanFront)
        If dBetweenClassVari > dMaxBetweenClassVari Then
            dMaxBetweenClassVari = dBetweenClassVari
            lBestThreshold = t
        End If
NextThreshold:
    Next

    '最適なしきい値で白黒に振り分け（Grayを再利用）
    ReDim rgbDataBin(UBound(rgbDataOrg, 1), UBound(rgbDataOrg, 2))
    Dim bBinary As Byte
    For lY = 0 To lHeight - 1
        For lX = 0 To lWidth - 1
            If bGrayData(lY, lX) < lBestThreshold Then
                bBinary = 0      '白
            Else
                bBinary = 255    '黒
            End If
            
            rgbDataBin(lY, lX).rgbRed = bBinary
            rgbDataBin(lY, lX).rgbGreen = bBinary
            rgbDataBin(lY, lX).rgbBlue = bBinary
        Next
    Next

    'RGBデータを更新
    m_rgbImageData = rgbDataBin
    
End Sub

　
標準モジュール

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.Binarization                   '二値化
    Call oBitmap.ExportBitmap24(sPathBmpExport) '画像出力

End Sub

使い方は非常にシンプルで上記コードのように既に用意しておいた画像の入出力処理の間に、二値化処理を呼び出すだけです。大津の二値化を適用したい場合はBinarizationOtsu関数を呼び出すだけです。
　

コード解説

大津の二値化は画像のヒストグラムを解析し白側と黒側のクラス間分散が最大となるようなしきい値を自動的に求める手法と前述していますが、ここではもう少し詳細に解説します。

まず二値化の前処理として画像をグレースケールに変換すると、各画素は0～255の明るさで表せるようになります。これをグラフにしたのがヒストグラムで、画像全体の明暗の分布を表しています。

このヒストグラムに境界線を引いて、左を黒グループ、右を白グループとすると、境界の位置によってグループの分け方が変わります。境界をいろいろ動かしながら試してみると、黒と白が一番はっきり分かれる位置が見つかります。これが大津の二値化で求められる最適なしきい値です。

この黒と白が一番はっきり分かれる位置を厳密に定義すると2つのグループの平均の差が最大になり、かつそれぞれのまとまり具合(分布のバラつき)を考慮したときに最も分離が良い点ということになります。大津の二値化ではこの分離の良さをクラス間分散という数値で表します。しきい値を0から255まで全部試してその中でクラス間分散が一番大きくなる位置を選べば、それが最適なしきい値となります。

サンプルコードでは下記で上記の処理を行っており、大津の二値化の処理の核といえる部分です。

    '最適なしきい値の計算
    dSumBack = 0
    dWeightwBack = 0
    dMaxBetweenClassVari = -1
    lBestThreshold = 0
    For t = 0 To 255
        dWeightwBack = dWeightwBack + lHistogram(t)
        If dWeightwBack = 0 Then GoTo NextThreshold

        dWeightwFront = lTotalPixels - dWeightwBack
        If dWeightwFront = 0 Then Exit For

        dSumBack = dSumBack + CDbl(t) * CDbl(lHistogram(t))
        dMeanBack = dSumBack / dWeightwBack
        dMeanFront = (lSumAll - dSumBack) / dWeightwFront

        dBetweenClassVari = dWeightwBack * dWeightwFront * (dMeanBack - dMeanFront) * (dMeanBack - dMeanFront)
        If dBetweenClassVari > dMaxBetweenClassVari Then
            dMaxBetweenClassVari = dBetweenClassVari
            lBestThreshold = t
        End If
NextThreshold:
    Next