第10回 VBAのテクスチャ描画システムを拡張する(1)

カンデラ開発者コラム 2023-02-28

カンデラの開発者による連載コラムです。第10回は、「VBAのテクスチャ描画システムを拡張する(1)」です。

前回までの内容で、VBAを用いた描画システムに独自のフォーマットの画像を読み込んで表示することができるようになりました。今回からはこの仕組みを少し強化していきたいと思います。

強化する内容

前回までで実装したシステムには、欠点があります。例えば図1のような設定で画像を描画してみます。そうすると、ファイルの読み込みが2回発生することになります。もう一つは、画像の全容が表示されるまで、比較的長く時間がかかってしまうことです( 図2 )。このような状況では、メモリが無駄使いになりますし、アニメーションなどを行った場合画面の描画が遅くなってしまいます。これらのボトルネックの解消方法について、ここから数回、考えてみたいと思います。今回はその前半戦、ファイルの無駄読みを抑制する方法について考えたいと思います。

図1. 同じテクスチャを2枚読み込む設定

図2. 描画途中のキャプチャ

既に読み込んだ画像の有効活用

既に読み込んだ画像を有効活用するために、まずは既存の構造を見直します。前回の実装では図3のような構造になっています。これでは、imageシートの1行分の内容に対して、必ず画像の読み込みが発生してしまいます。そこで、今回は図4のような形で、imageシートを画像リソースを読み込むだけの役割にします。そして、imageシートの通し番号を使って画像を描画することにします。つまり、これまでのimageシートを2つに分離して、SWImageDarw構造体を改造し、描画ルーチンを改良する流れになります。新しいSWImageDraw構造体では、SWImageの実体を持たず、代わりにimageシート上のテクスチャの番号を指定します。その番号から、SWImageの実体を取得し、SWImageStructureと描き出し位置をRenderingSystemに渡して画像を描画します。具体的にはSWImageDraw構造体の仕組みを変更し( リスト1 )、前回のimageシートの読み込み部分をimageシートとimagedrawシートの読み込み処理に変更し( リスト2 )、描画関数をリスト3のように変更します。最後のEntryPointモジュールのMain関数もこれらに合わせる形で書き換えます( リスト4 )。残念ながら、この改修作業を行っても得られる描画結果も、それにかかる時間も同じです。ひとまず問題なく動作することが確認できればよしとしましょう。

図3. 前回までの実装におけるデータ構造

図4. 改善方針

SWImageDraw構造体( ソースコードを見る )


Public Type SWImageDraw
    id As Integer
    imageID As Integer
    pos As Position
End Type

リスト1. SWImageDraw構造体( 改 )

imageシートとimagedrawシートの内容の読み込み( ソースコードを見る )


Sub SetupImage(ByRef aImage() As SWImage)
    ' まずはimageシートの有効な行の数を調べる.
    Dim nRowCnt As Integer
    Dim nElementCnt As Integer
    
    Dim nRows As Integer
    With Worksheets("image")
        nRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
    End With
    
    ReDim aImage(nRows - 1)
    
    For nRowCnt = 2 To 2 + nRows - 1
        With Worksheets("image")
            ' 1列目が管理番号.
            aImage(nElementCnt).id = .Cells(nRowCnt, 1).Value
            
            ' 2列目はファイル名なので、ここで画像の読み込み処理をコール.
            Call LoadImage(aImage(nElementCnt).image, ThisWorkbook.Path & PATH_DELIMITER & .Cells(nRowCnt, 2).Value)
                        
            nElementCnt = nElementCnt + 1
        End With
    Next
    
End Sub
Sub SetupImageDraw(ByRef aImageDraw() As SWImageDraw)
    ' まずはimagedrawシートの有効な行の数を調べる.
    Dim nRowCnt As Integer
    Dim nElementCnt As Integer
    
    Dim nRows As Integer
    With Worksheets("imagedraw")
        nRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
    End With
    
    ReDim aImageDraw(nRows - 1)
    
    For nRowCnt = 2 To 2 + nRows - 1
        With Worksheets("imagedraw")
            ' 1列目は管理番号.
            aImageDraw(nElementCnt).id = .Cells(nRowCnt, 1).Value
            
            ' 2列目はImageID.
            aImageDraw(nElementCnt).imageID = .Cells(nRowCnt, 2).Value
            
            ' 3列目からは座標.
            aImageDraw(nElementCnt).pos.x = .Cells(nRowCnt, 3).Value
            aImageDraw(nElementCnt).pos.y = .Cells(nRowCnt, 4).Value
            
            nElementCnt = nElementCnt + 1
        End With
    Next nRowCnt

End Sub

リスト2. imageシートとimagedrawシートの内容の読み込み( EntryPointモジュール )

DrawImageルーチン( ソースコードを見る )


Sub DrawImage(ByRef pos As Position, ByRef rImageStructure As SWImageStructure)
    ' rImageStructure.dataの内容をコピーする.
    Dim nRowStart As Long
    Dim nColStart As Long
    
    ' カウンタ変数を用意.
    Dim nRowCnt As Long: nRowCnt = 0
    Dim nColCnt As Long: nColCnt = 0
    
    ' 読み込んだ画像データ上のピクセルの開始位置.
    Dim nPixelPosition As Long: nPixelPosition = 0
    
    ' 色を一時的に格納する変数.
    Dim sColor As ColorRGB
    
    ' ピクセル辺り何Bytesか( デフォルトは4 ).
    Dim nBytesPerPixel As Integer: nBytesPerPixel = 4
    
    ' ただし、画像フォーマットが0番の場合は3.
    If IMAGE_FORMAT_TYPE_RGB = rImageStructure.format Then
        nBytesPerPixel = 3
    End If
    
    nRowStart = pos.y + 1
    nColStart = pos.x + 1
    
    With Worksheets("framebuffer")
        ' 幅( 列 )を塗りきったら改行.
        For nRowCnt = 0 To rImageStructure.height - 1
            For nColCnt = 0 To rImageStructure.width - 1
                ' 読み込んだ画像データ上の位置.
                nPixelPosition = nBytesPerPixel * (nColCnt + nRowCnt * rImageStructure.width)
                
                ' この形式では色はRGB(A)の順番で格納されている.
                ' まだアルファチャネルは考慮しない.
                sColor.R = rImageStructure.data(nPixelPosition)
                sColor.G = rImageStructure.data(nPixelPosition + 1)
                sColor.B = rImageStructure.data(nPixelPosition + 2)
                .Cells(nRowStart + nRowCnt, nColStart + nColCnt).Interior.color = RGB(sColor.R, sColor.G, sColor.B)
            Next nColCnt
        Next nRowCnt
    End With
End Sub

リスト3. DrawImageルーチン( RenderingSystemクラス )

Mainルーチン( ソースコードを見る )


Sub Main()
    Dim cRenderSystem As RenderingSystem
    Set cRenderSystem = New RenderingSystem
    
    ' Rectの格納場所を用意.
    Dim aRect() As Rect
    Dim nCnt As Integer
    
    ' imageの格納場所を用意.
    Dim aImage() As SWImage
    
    ' imagedrawの格納場所を用意.
    Dim aImageDraw() As SWImageDraw
        
    ' 初期化処理をコール.
    Call Initialize(cRenderSystem)
    
    ' rectシートから、Rectをセットアップ.
    Call SetupRect(aRect)
    
    ' imageシートから、SWImageをセットアップ.
    Call SetupImage(aImage)
    
    ' imagedrawシートから、SWImageDrawをセットアップ.
    Call SetupImageDraw(aImageDraw)
    
    ' aRectの要素数に合わせてRenderingSystemのDrawRectをコール.
    For nCnt = LBound(aRect) To UBound(aRect)
        Call cRenderSystem.DrawRect(aRect(nCnt))
    Next
    
    ' aImageの要素数に合わせてRenderingSystemのDrawImageをコール.
    For nCnt = LBound(aImageDraw) To UBound(aImageDraw)
        Call cRenderSystem.DrawImage(aImageDraw(nCnt).pos, aImage(aImageDraw(nCnt).imageID).image)
    Next
    
    ' 終了処理をコール.
    Call Terminate(cRenderSystem)
End Sub

リスト4. Mainルーチン( EntryPointモジュール )

今回は目に見える実装ではなく、下回りを整えるような内容でしたが、この対応をすることで、画像を無駄に読み込むことを抑制することができました。この段階でその成果を確認する場合は、前回までの実装と今回の実装とで、同一の画像ファイルを大量に描画する設定をし動作させてみるとその差を体感できるかもしれません。次回は、現行の仕様(システム)における描画の高速化について考えてみたいと思います。

第9回はこちら

第11回はこちら

コラムトップへ