申し込み
TOPーColumnsーカンデラ開発者コラムー第11回 VBAのテクスチャ描画システムを拡張する(2)

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

カンデラ開発者コラム

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

前回は、VBAを用いたテクスチャ描画システムに対して、既に読み込み済みの画像についてはそれをうまく活用し、無駄な読み込みを減らすという改善を行いました。今回も前回に引き続き、このシステムの強化を考えていきたいと思います。
 

強化する内容

強化する内容について、もう一度確認しましょう。前回まは、図1のように同一の画像を複数枚描画する場合に無駄な読み込みが行われていた仕様を改善しました。残るは、図2のように、画像すべてが描画されるまで時間がかかってしまう問題です。今回はこの描画速度の改善について考えてみたいと思います。

 

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

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

描画の高速化

現状ですと、図2のように、画像がframebufferシートに表示されるまでかなり待たされます。一方で、Rectの描画は一瞬です。これは、指定領域を一気に塗りつぶす( 四角形 )処理と、1ピクセルずつ色を決定していく処理( 画像 )の差だと考えることができます。指定範囲を指定色で塗りつぶすのが高速なら、指定範囲を別の指定範囲で塗りつぶすのも高速ではないかと予想できます。イメージとしては、まさに図3そのものを実現したいということになります。

 

図3. これを実現したい
 

では、図3の状況を実現するにはどうすればよいでしょうか？描画面とは別の描画面のようなものがあれば実現可能となります。この実装は、システムにとって都合の良いメモリに予め画像データを展開しておくというものになります。OpenGL ESなどが動作するGPU付きの環境ではこのようなシステムにとって都合の良い領域がVRAMということになります。つまり、これからやろうとしていることは、このVBAの仕組みが画像を高速に読み込むことのできる領域、つまりVRAMを作成することになります。そこで、図4のような仕組みを実装しましょう。具体的には、新たにvramというシートを作成し、画像を読み込んだ際に仮の描画面として、vramシートに読み込んだByte列を描き込みます。次に、それを描画するデータがimagedrawシートに存在している場合、SWImageStructure構造体に含まれているvramシート上の位置から、同構造体の持つ幅高さの領域分の色をSWImageDrawが持つ描画位置を参照し、framebufferシートに描き込みます。これらの処理を実装していくことになります。

 

図4. これを実現する

図4の仕組みが実現された場合、図2のような現象が発生しなくなるはずです。ですので、この仕組みを実装した後に、図2と同様の描画を試してみてframebufferシートへの描画が一瞬で終わることを確認しましょう。残念ながらvramシートへの描画については、1セルずつ色を乗せていくしかないため、ここは高速化することはできませんが、それでも描画面には一瞬で反映されるためこれらの処理を実装する価値は十分にあると考えられます。それでは実装していきましょう。まずは、vramシートを用意しframebufferシート同様、セルの大きさを調整しましょう( 図5 )。次にSWImageStructreを拡張します。vramシート上の開始位置( 左上 )を記録するためにPosition構造体をメンバに追加します( リスト1 )。

 

図5. 幅1、高さ11に設定したvramシート
 
vramシート上のテクスチャ領域開始位置を記録する場所( ソースコードを見る ) 

Public Type SWImageStructure
    format As Long
    width As Long
    height As Long
    padding As Long
    
    data() As Byte
    
    ' テクスチャ専用領域の左上を指す.
    posUV As Position
End Type
リスト1. vramシート上のテクスチャ領域開始位置を記録する場所
 

さて、ここまで作成したところで、一つ大きな課題があります。vramシートに読み込まれた画像はどのように配置していけばよいでしょうか。複数の画像を読み込んだ際にどのように画像を並べていけばよいでしょうか。これは、決まった大きさの矩形の中にサイズの異なる矩形を隙間なく敷き詰めるという問題になるのですが、厳密にこの問題を解こうとするとかなりのコストがかかりますし、もしかしたら終了しない処理が出来上がる可能性があります。そこで、今回はあまり深く考えずに、とにかく左から右に画像を並べていきます。ある画像をvramシートに描画しようとしたときに、指定幅を超えそうまらば改行、その際の改行の高さはその行の中で最も大きな画像に合わせるという贅沢な使い方をします( 図6 )。一方で、今回はこのような割り切った仕様ですので、図7のように読み込む画像の大きさ次第では、非効率な配置になってしまう可能性があります。ですので複数の画像を扱う場合は、なるべく画像の大きさは揃えて効率よく配置することを運用面で意識していくことにしましょう。

 

図6. vramシートの画像の配置方法
 

図7. 画像配置のユースケース
 

では、図6の仕組みを実装していきます。今回は既存のLoadImage関数で読み込んだバイト列を、vramシートにキャッシュする機能(CacheImage)を実装しましょう。つまり、LoadImgeのあとにCacheImageをコールするような流れになります。まずは、新たにImageCacheクラスを準備します( リスト2 )。外部からはvramシートを初期化するためのSetup、LoadImageで読み込んだバイト列をvramシートに描画するためのRegisterの2つの処理をコールすることになります。次に、RenderSystemクラスにvramシートの内容をコピーする処理、DrawCachedImageを実装します( リスト3 )。

 
ImageCacheクラスの実装( ソースコードを見る ) 

Option Explicit


' vram領域の幅と高さ.
Private m_wh As WidthHeight
' 現在の行の最大高.
Private m_level As Integer
' 次の描き出し位置.
Private m_nowPos As Position

Private Sub ImageCache_Initialize()
    m_wh.height = 0
    m_wh.width = 0
        
    m_level = 0
    
    m_nowPos.x = 0
    m_nowPos.y = 0
    
End Sub

Private Sub ImageCache_Terminate()
    ' 破壊ルーチンは今の所は何も行わない.
End Sub

Public Sub Setup(ByVal width As Integer, ByVal height As Integer)
    ' 初期化時に1度呼び出す.
    ' 幅と高さを設定する.
    Call SetBufferWidthHeight(width, height)
    ' 指定領域をクリアしておく.
    Call Clear
End Sub

Public Sub Register(ByRef rImageStructure As SWImageStructure)
    ' 渡された画像を初期化.
    If 0 <= rImageStructure.posUV.x Then
        ' 既に画像が登録されているようならば何もしない.
        Exit Sub
    End If
    
    If 0 <= rImageStructure.posUV.y Then
        ' 既に画像が登録されているようならば何もしない.
        Exit Sub
    End If
    
    ' 現在の位置から、幅高さ分を描画する.
    If Not IsDrawable(rImageStructure) Then
        ' 現在位置から描画できない.
        ' 改行したら描画できるか.
        If IsDrawableNewLine(rImageStructure) Then
            Call MoveToNewLine
            Call DrawImage(m_nowPos, rImageStructure)
            Call UpdateCache(rImageStructure)
        End If
    Else
        Call DrawImage(m_nowPos, rImageStructure)
        Call UpdateCache(rImageStructure)
    End If
End Sub

Private Sub MoveToNewLine()
    ' 現在のlevelの値を足しこみ、列を0に戻したものを新しい現在位置とする.
    m_nowPos.y = m_nowPos.y + m_level
    m_nowPos.x = 0
    
    m_level = 0
End Sub

Private Function IsDrawable(ByRef rImageStructure As SWImageStructure) As Boolean
    ' 今の状態で描画できるか.
    IsDrawable = True
    
    If m_wh.width <= m_nowPos.x + rImageStructure.width Then
        IsDrawable = False
    End If
    
    If m_wh.height <= m_nowPos.y + rImageStructure.height Then
        IsDrawable = False
    End If
    
End Function

Private Function IsDrawableNewLine(ByRef rImageStructure As SWImageStructure) As Boolean
    ' 改行したら描画できるか.
    Dim posWork As Position
    posWork.x = 0
    posWork.y = m_nowPos.y + m_level
    
    IsDrawableNewLine = True
    If m_wh.width <= posWork.x + rImageStructure.width Then
        IsDrawableNewLine = False
    End If
    
    If m_wh.height <= posWork.y + rImageStructure.height Then
        IsDrawableNewLine = False
    End If
    
End Function

Private Sub UpdateCache(ByRef rImageStructure As SWImageStructure)
    ' posUVを更新.
    rImageStructure.posUV.x = m_nowPos.x
    rImageStructure.posUV.y = m_nowPos.y
    
    ' 今までで一番高いテクスチャの場合はlevelを更新.
    If m_level < rImageStructure.height Then
        m_level = rImageStructure.height
    End If
    
    ' 位置更新.
    m_nowPos.x = m_nowPos.x + rImageStructure.width
End Sub

Private Sub DrawImage(ByRef pos As Position, ByRef rImageStructure As SWImageStructure)
    ' 実装の内容としては、RenderingSystem.DrawImageとほぼ同じ.
    ' ただしこの処理は外部からはコールできない.
    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
    
    Dim nBytesPerPixel As Integer: nBytesPerPixel = 4
    
    If IMAGE_FORMAT_TYPE_RGB = rImageStructure.format Then
        nBytesPerPixel = 3
    End If
    
    nRowStart = pos.y + 1
    nColStart = pos.x + 1
    
    With Worksheets("vram")
        For nRowCnt = 0 To rImageStructure.height - 1
            For nColCnt = 0 To rImageStructure.width - 1
                nPixelPosition = nBytesPerPixel * (nColCnt + nRowCnt * rImageStructure.width)
                
                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


Private Sub SetBufferWidthHeight(ByVal width As Integer, ByVal height As Integer)
    Dim nPrevWidth As Integer: nPrevWidth = m_wh.width
    Dim nPrevHeight As Integer: nPrevHeight = m_wh.height
    
    If 0 < width Then
        m_wh.width = width
    End If
    
    If 0 < height Then
        m_wh.height = height
    End If
    
    ' 指定された大きさが異なる場合は、その大きさでリサイズ.
    If nPrevWidth <> m_wh.width Or nPrevHeight <> m_wh.height Then
        Call Resize
    End If
    
End Sub

Private Sub Resize()
    ' リサイズ時に実行する処理.
    ' 現在のところは何も行わない.
End Sub

Private Sub Clear()
    ' vramシートの当該範囲をクリアする.
    With Worksheets("vram")
        .Range(.Cells(1, 1), .Cells(m_wh.height, m_wh.width)).Interior.ColorIndex = 0
        
    End With
    
End Sub
リスト2. ImageCacheクラスの実装
 
RenderingSystemクラスにDrawCachedImage( ソースコードを見る ) 

Public Function DrawCachedImage(ByRef pos As Position, ByRef rImageStructure As SWImageStructure)
    DrawCachedImage = False
    
    If 0 <= rImageStructure.posUV.x And 0 <= rImageStructure.posUV.y Then
        ' UV座標系が決まっているということはvramシートにCacheされているということ.
        ' vramシートの指定領域を、framebufferシートの指定領域にコピー.
        Dim nRowStart As Integer: nRowStart = pos.y + 1
        Dim nColStart As Integer: nColStart = pos.x + 1
        
        Dim nRowEnd As Integer: nRowEnd = nRowStart + rImageStructure.height - 1
        Dim nColEnd As Integer: nColEnd = nColStart + rImageStructure.width - 1
        
        Dim nVramRowStart As Integer: nVramRowStart = rImageStructure.posUV.y + 1
        Dim nVramColStart As Integer: nVramColStart = rImageStructure.posUV.x + 1
        
        Dim nVramRowEnd As Integer: nVramRowEnd = nVramRowStart + rImageStructure.height - 1
        Dim nVramColEnd As Integer: nVramColEnd = nVramColStart + rImageStructure.width - 1
        
        Dim framebuffer As Worksheet: Set framebuffer = Worksheets("framebuffer")
        Dim vram As Worksheet: Set vram = Worksheets("vram")
        
        ' .Interior.colorは範囲指定でコピーできないため、内容をそのままコピーする.
        vram.Range(vram.Cells(nVramRowStart, nVramColStart), vram.Cells(nVramRowEnd, nVramColEnd)).Copy Destination:= _
        framebuffer.Range(framebuffer.Cells(nRowStart, nColStart), framebuffer.Cells(nRowEnd, nColEnd))
        DrawCachedImage = True
    End If
    
End Function
リスト3. RenderingSystemクラスにDrawCachedImage
 

次に、EntryPointモジュールにImageCacheクラスのインスタンスを持たせて、初期化する処理を追加します。また、この流れで、もともと存在していたInitializeルーチンを分割してImageCacheとRenderingSystemの初期化処理をコールするつくりにします( リスト4 )。

 
EntryPointモジュールの一部改修( ソースコードを見る ) 

Sub Initialize(ByRef rRenderingSystem As RenderingSystem, ByRef rVram As ImageCache)
    Call InitializeVRAMSystem(rVram)
    Call InitializeRenderingSystem(rRenderingSystem)
End Sub

Private Sub InitializeVRAMSystem(ByRef rVram As ImageCache)
    ' 画面の幅、高さ、クリアの色を格納しておく変数.
    Dim nWidth As Integer, nHeight As Integer
    
    ' 対象シートの内容を読み込んでまずは必要な情報を取得する.
    nWidth = Worksheets("configuration").Range("B3").Value
    nHeight = Worksheets("configuration").Range("C3").Value
        
    ' 初期化.
    Call rVram.Setup(nWidth, nHeight)
        
    ' vramシートの表示倍率を小さめにしておく.
    With Worksheets("vram")
        .Activate
        .Cells(1, 1).Select
    End With
    ActiveWindow.Zoom = 10
    
End Sub

Private Sub InitializeRenderingSystem(ByRef rRenderingSystem As RenderingSystem)
    ' 画面の幅、高さ、クリアの色を格納しておく変数.
    Dim nWidth As Integer, nHeight As Integer
    Dim nR As Integer, nG As Integer, nB As Integer
    
    ' 対象シートの内容を読み込んでまずは必要な情報を取得する.
    nWidth = Worksheets("configuration").Range("B1").Value
    nHeight = Worksheets("configuration").Range("C1").Value
    
    nR = Worksheets("configuration").Range("B2").Value
    nG = Worksheets("configuration").Range("C2").Value
    nB = Worksheets("configuration").Range("D2").Value
    ' Systemのクラスにその値をセット.
    Call rRenderingSystem.SetBufferWidthHeight(nWidth, nHeight)
    Call rRenderingSystem.SetColor(nR, nG, nB)
    
    ' framebufferをクリア.
    Call rRenderingSystem.Clear
    
    ' framebufferのシートの表示倍率を小さめにしておく.
    Worksheets("framebuffer").Activate
    Worksheets("framebuffer").Cells(1, 1).Select
    ActiveWindow.Zoom = 10
    
End Sub
リスト4. EntryPointモジュールの一部改修
 

続いて、このImageCacheクラスのインスタンスに読み込んだ画像を登録する処理を作成します。先程のImageCacheクラスのRegisterをコールする流れになります( リスト5 )。最後に、これらをMainルーチン内から呼び出す処理を実装します( リスト6 )。

 
ImageCacheクラスの処理をEntryPointモジュールでコール 

Sub CacheImage(ByRef rVram As ImageCache, ByRef rImageStructure As SWImageStructure)
    ' ImageCacheに登録.
    rVram.Register (rImageStructure)
End Sub

Sub SetupImageCache(ByRef rVramSystem As ImageCache, ByRef aImage() As SWImage)
    Dim nCnt As Integer
    For nCnt = LBound(aImage) To UBound(aImage)
        Call rVramSystem.Register(aImage(nCnt).image)
    Next
End Sub
リスト5. ImageCacheクラスの処理をEntryPointモジュールでコール
 
Mainルーチン 

Sub Main()
    Dim cRenderSystem As RenderingSystem
    Set cRenderSystem = New RenderingSystem
    
    Dim cVramSystem As ImageCache
    Set cVramSystem = New ImageCache
    
    ' Rectの格納場所を用意.
    Dim aRect() As Rect
    Dim nCnt As Integer
    
    ' imageの格納場所を用意.
    Dim aImage() As SWImage
    
    ' imagedrawの格納場所を用意.
    Dim aImageDraw() As SWImageDraw
        
    ' 初期化処理をコール.
    Call Initialize(cRenderSystem, cVramSystem)
    
    ' rectシートから、Rectをセットアップ.
    Call SetupRect(aRect)
    
    ' imageシートから、SWImageをセットアップ.
    Call SetupImage(aImage)
    
    ' Cacheをセットアップ.
    Call SetupImageCache(cVramSystem, 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)
        ' 上記の代わりにDrawCachedImageをコールする.
        Call cRenderSystem.DrawCachedImage(aImageDraw(nCnt).pos, aImage(aImageDraw(nCnt).imageID).image)
        
    Next
    
    ' 終了処理をコール.
    Call Terminate(cRenderSystem, cVramSystem)
End Sub
リスト6. Mainルーチン
 

動作確認

それでは動作確認をしてみましょう。設定関連はこれまでの図に出てきたものをそのまま使います。実行ボタンを押してみて、画像が正しく表示されることを確認してください。今回の設定では、framebufferシートは図8のような状態に、vramシートは図9のような状態にそれぞれなっているはずです。

 

図8. framebufferシート
 

図9. vramシート
 

ここまで動作確認ができたら、次に複数の画像を読み込ませてみましょう。VRAMの大きさを、400×300にして、128×128のテクスチャを4枚読み込ませ( 図10 )、framebufferシートとvramシートの状態を確認してみます( 図11 )。

 

図10. 各種設定
 

図11. 描画結果
 

いかがでしたでしょうか？これで多少効率的なシステムになりました。まだまだ改良の余地はありますし、今後回転やスケールなどの処理を実装した場合はこれまでとは全く異なった視点でのロジックを設計・実装しなければなりませんが、現段階ではそれなりに効率の良いものが出来上がったと思います。次回はここに新たな描画を追加したいと思います。前回と今回で実装した改善がその新たな描画で役に立つのかどうかという側面でも考えていきたいと思います。



 
コラムトップへ