【VBA×画像処理】ビットマップ画像の指定位置に長方形を描画する

本ページでは、VBAで読み込んだビットマップ（BMP）画像に対して、指定された位置・サイズ・色・太さで長方形を描画する方法を解説していきます。画像処理においてある特定領域を強調表示したり、検出結果を可視化したりするケースは多く、長方形の描画は次回紹介するテンプレートマッチングなどの結果を画像上にマーキングする際にも頻繁に利用される基本的な処理です。

注意事項

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

Contents

1. 長方形の描画
2. サンプルコード
3. 関連情報

長方形の描画

長方形の描画処理は、指定された矩形領域の枠線部分のピクセルだけを指定色で上書きする処理です。長方形の左上座標を \( (x_{\min}, y_{\min}) \)、右下座標を \( (x_{\max}, y_{\max}) \)、枠線の太さを \( t \) とすると、座標 \( (x, y) \) が枠線上にあるかどうかは下記の式で判定します。

\[
\begin{cases}
1.\,\, (x_{\min} – \frac{t}{2} \le x \le x_{\max} + \frac{t}{2}) \,\land\, \\
\quad\quad \bigl( (y_{\min} – \frac{t}{2} \le y \le y_{\min} + \frac{t}{2}) \,\lor\, (y_{\max} – \frac{t}{2} \le y \le y_{\max} + \frac{t}{2}) \bigr) \\
2.\,\, (y_{\min} – \frac{t}{2} \le y \le y_{\max} + \frac{t}{2}) \,\land\, \\
\quad\quad \bigl( (x_{\min} – \frac{t}{2} \le x \le x_{\min} + \frac{t}{2}) \,\lor\, (x_{\max} – \frac{t}{2} \le x \le x_{\max} + \frac{t}{2}) \bigr)
\end{cases}
\]

1.は長方形の上辺と下辺に対応し、2.は左辺と右辺に対応します。いずれかの条件を満たすピクセルが枠線上のピクセルであり、これらに指定色を割り当てることで長方形が描画されます。それ以外のピクセルには元画像の色をそのまま格納します。

また、描画色 \( C \) はLong型の整数値（0x00BBGGRR形式ではなく、本実装では下位バイトから R, G, B の順で格納）として渡され、各成分は次のように取り出します。

\[
\begin{cases}
R = C \,\&\, \mathrm{0xFF} \\
G = (C \,\&\, \mathrm{0xFF00}) \gg 8 \\
B = (C \,\&\, \mathrm{0xFF0000}) \gg 16
\end{cases}
\]

たとえば \( C = 255 \) を指定するとR=255, G=0, B=0となり、赤色の長方形が描画されます。なお、この格納順序はVBA標準の RGB(R, G, B) 関数の戻り値と一致するため、RGB(0, 0, 255) のように直感的な色指定が可能です（詳細は後述）。
　

サンプルコード

以下は画像に長方形を描画するためのコードです。事前に用意しておいたclsBitmap内に下記コードをコピペすることで利用可能になります。引数として長方形の左上・右下座標と、オプションで色および枠線の太さを指定可能です。色/太さを省略した場合はそれぞれ赤色/1ピクセルで描画されます。

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

'****************************************************************************
'*  長方形を描画
'*
'*      lMinX       ：左上X座標
'*      lMinY       ：左上Y座標
'*      lMaxX       ：右下X座標
'*      lMaxY       ：右下Y座標
'*      (lColor)    ：色 (省略時は赤色)
'*      (lThickness)：枠線の太さ[px] (省略時は1px)
'****************************************************************************
Public Sub Rectangle(lMinX As Long, lMinY As Long, lMaxX As Long, lMaxY As Long, _
                     Optional lColor As Long = 255, Optional lThickness As Long = 0)
                 
    Dim rgbDataOrg()  As RGBTRIPLE '元画像RGBデータ
    Dim rgbDataRect() As RGBTRIPLE '長方形描画後画像RGBデータ

    Dim lHeight    As Long
    Dim lWidth     As Long
    Dim lX         As Long
    Dim lY         As Long
    Dim lThickHalf As Long
    
    '入力値確認
    If lMinX >= lMaxX Or lMinY >= lMaxY Then
        Exit Sub
    End If

    '元画像情報を取得
    rgbDataOrg = m_rgbImageData
    lHeight = UBound(rgbDataOrg, 1) + 1  '配列は0始まりなので+1で補正
    lWidth = UBound(rgbDataOrg, 2) + 1   '配列は0始まりなので+1で補正
    
    '画像範囲外の長方形が入力された場合は処理を中断
    If lMinX < 0 Or lMinY < 0 Or lMaxX >= lWidth Or lMaxY >= lHeight Then
        Exit Sub
    End If
    
    '配列サイズを定義(元画像と同じ2次元配列)
    ReDim rgbDataRect(UBound(rgbDataOrg, 1), UBound(rgbDataOrg, 2))
    
    '空の2次元配列に元画像データを格納していく
    lThickHalf = lThickness \ 2
    For lY = 0 To lHeight - 1
        For lX = 0 To lWidth - 1
            
            '指定座標の長方形(枠線)部分は元データでなく指定色を格納する
            If ((lMinX - lThickHalf <= lX And lX <= lMaxX + lThickHalf) And _
               ((lMinY - lThickHalf <= lY And lY <= lMinY + lThickHalf) Or (lMaxY - lThickHalf <= lY And lY <= lMaxY + lThickHalf))) Or _
               ((lMinY - lThickHalf <= lY And lY <= lMaxY + lThickHalf) And _
               ((lMinX - lThickHalf <= lX And lX <= lMinX + lThickHalf) Or (lMaxX - lThickHalf <= lX And lX <= lMaxX + lThickHalf))) Then
                 
                rgbDataRect(lY, lX).rgbRed = &HFF& And lColor
                rgbDataRect(lY, lX).rgbGreen = (&HFF00& And lColor) \ 256
                rgbDataRect(lY, lX).rgbBlue = (&HFF0000 And lColor) \ 65536
            Else
                rgbDataRect(lY, lX).rgbRed = rgbDataOrg(lY, lX).rgbRed
                rgbDataRect(lY, lX).rgbGreen = rgbDataOrg(lY, lX).rgbGreen
                rgbDataRect(lY, lX).rgbBlue = rgbDataOrg(lY, lX).rgbBlue
            End If
        Next
    Next

    'RGBデータを更新
    m_rgbImageData = rgbDataRect
    
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.Rectangle(50, 50, 200, 150, RGB(0, 0, 255), 3)       '長方形を描画(青色,太さ3px)
    Call oBitmap.ExportBitmap24(sPathBmpExport)                       '画像出力

End Sub

使い方は非常にシンプルで上記コードのように既に用意しておいた画像の入出力処理の間に、長方形の描画処理を呼び出すだけです。色指定にはVBA標準の RGB(R, G, B) 関数の戻り値をそのまま渡せるため、RGB(255, 0, 0) で赤色、RGB(0, 255, 0) で緑色、RGB(0, 0, 255) で青色のように直感的に色を指定できます。また複数回呼び出して複数の長方形を描画することもでき、検出結果や領域指定の可視化に活用できます。
　