第7回 ソフトウェアレンダリングを実装してみる(実装編)
カンデラの開発者による連載コラムです。 第7回は、「ソフトウェアレンダリングを実装してみる(実装編)」です。
configurationシートの読み込み
configurationシートで設定されている描画面の幅と高さ、クリアするときの色の設定を読み込みます。共通で使いそうな型を標準モジュールにリスト1の内容で記述し、先程のエントリポイントを作成したモジュール内に、configurationシートの内容を読み込む仕組みを用意します( リスト2 )。そして、RenderingSytemというクラスモジュールを追加し、そこに、フレームバッファに関する情報や指定範囲をクリアする処理を実装します( リスト3 )。ここまで実装を終えたら動作確認として、実行ボタンをクリックし、指定色で画面がクリアできている( 指定色で塗りつぶされている )ことを確認します。
必要な型を定義( ソースコードを見る )
Public Type WidthHeight
width As Integer
height As Integer
End Type
Public Type ColorRGB
R As Integer
G As Integer
B As Integer
End Type
EntryPointモジュール( ソースコードを見る )
Sub Initialize(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
Sub Terminate(ByRef rRenderingSystem As RenderingSystem)
' 終了処理は特に何も行わない.
' Call rRenderingSystem.DebugClear
End Sub
Sub Main()
Dim cRenderSystem As RenderingSystem
Set cRenderSystem = New RenderingSystem
' 初期化処理をコール.
Call Initialize(cRenderSystem)
' 終了処理をコール.
Call Terminate(cRenderSystem)
End Sub
RenderingSystemモジュール( ソースコードを見る )
Option Explicit
Private m_wh As WidthHeight
Private m_color As ColorRGB
Function GetColor() As ColorRGB
GetColor = m_color
End Function
Function GetBufferWidth() As Integer
GetBufferWidth = m_wh.width
End Function
Function GetBufferHeight() As Integer
GetBufferHeight = m_wh.height
End Function
Function SetColor(ByVal R As Integer, ByVal G As Integer, ByVal B As Integer)
Dim nPrevR As Integer: nPrevR = m_color.R
Dim nPrevG As Integer: nPrevG = m_color.G
Dim nPrevB As Integer: nPrevB = m_color.B
If 0 <= R And R < 256 Then
m_color.R = R
End If
If 0 <= G And G < 256 Then
m_color.G = G
End If
If 0 <= B And B < 256 Then
m_color.B = B
End If
' 指定されたクリア色が異なる場合、その色で一旦クリア.
If nPrevR <> m_color.R Or nPrevG <> m_color.G Or nPrevB <> m_color.B Then
Call Clear
End If
End Function
Function 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 Function
Sub Resize()
' リサイズ時に実行する処理.
' 現在のところは特に何も行わない.
End Sub
Sub Clear()
' framebufferシートの該当範囲を指定色で塗りつぶす.
With Worksheets("framebuffer")
.Range(.Cells(1, 1), .Cells(m_wh.height, m_wh.width)).Interior.color = RGB(m_color.R, m_color.G, m_color.B)
End With
End Sub
Sub DebugClear()
' framebufferシートの該当箇所をクリアする.
With Worksheets("framebuffer")
.Range(.Cells(1, 1), .Cells(m_wh.height, m_wh.width)).Interior.ColorIndex = 0
End With
End Sub
矩形を描画する仕組みの準備
次に、矩形を描画するための準備をします。まずは、左上の座標、幅、高さ、色を格納するための構造体をTypesモジュールの中に用意します( リスト4 )。
Typesモジュールに追加する内容( ソースコードを見る )
Public Type Position
x As Integer
y As Integer
End Type
Public Type Rect
pos As Position
wh As WidthHeight
color As ColorRGB
End Type
そして、上記の構造体を受け取って長方形を描画するための仕組みをRenderingSystemモジュールに追加します( リスト5 )。今回は、回転もスケールも行いませんので、指定された領域を塗りつぶすという簡単な実装にしておきます。ここまで実装を終えたら、ひとまずエントリーポイントで矩形の描画処理を直接コールしてみましょう( リスト6 )。図3のように矩形が描画されればここまでの実装は完了です。
RenderingSystemモジュールに追記する内容( ソースコードを見る )
Sub DrawRect(ByRef rRect As Rect)
' framebufferシートの該当範囲を指定色で塗りつぶす.
Dim nRowStart As Integer
Dim nColStart As Integer
Dim nRowEnd As Integer
Dim nColEnd As Integer
nRowStart = rRect.pos.y + 1
nColStart = rRect.pos.x + 1
nRowEnd = nRowStart + rRect.wh.height - 1
nColEnd = nColStart + rRect.wh.width - 1
With Worksheets("framebuffer")
.Range(.Cells(nRowStart, nColStart), .Cells(nRowEnd, nColEnd)).Interior.color = RGB(rRect.color.R, rRect.color.G, rRect.color.B)
End With
End Sub
EntryPointモジュールからDrawRect関数をコールする( ソースコードを見る )
Sub Main()
Dim cRenderSystem As RenderingSystem
Set cRenderSystem = New RenderingSystem
' 初期化処理をコール.
Call Initialize(cRenderSystem)
' 直接矩形を描画してみる.
Dim testRect As Rect
' 座標( 2, 2 )から幅8, 高さ4、色は白の矩形を描画.
testRect.pos.x = 2
testRect.pos.y = 2
testRect.wh.width = 8
testRect.wh.height = 4
testRect.color.R = 255
testRect.color.G = 255
testRect.color.B = 255
Call cRenderSystem.DrawRect(testRect)
' 終了処理をコール.
Call Terminate(cRenderSystem)
End Sub
複数の矩形を描画してみる
せっかくですので、特定のシートに記述されているデータを元に複数の矩形を描画できる仕組みを作ってみましょう。左上の位置、幅、高さ、色を設定できるシートを追加します( 図4 )。
次に、rectシートの内容を読み込んでRect構造体を生成するための仕組みをEntryPointモジュールに実装します( リスト7 )。最後に、それをMainルーチン内でコールします( リスト8 )。
EntryPointモジュールを拡張( ソースコードを見る )
Sub SetupRect(ByRef aRect() As Rect)
' まずはRectシートの有効な列の数を調べる.
Dim nRowCnt As Integer
Dim nElementCnt As Integer
Dim nRows As Integer
With Worksheets("rect")
nRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
End With
ReDim aRect(nRows - 1)
For nRowCnt = 2 To 2 + nRows - 1
With Worksheets("rect")
' 2列目から位置.
aRect(nElementCnt).pos.x = .Cells(nRowCnt, 2).Value
aRect(nElementCnt).pos.y = .Cells(nRowCnt, 3).Value
' 4列目から幅高さ.
aRect(nElementCnt).wh.width = .Cells(nRowCnt, 4).Value
aRect(nElementCnt).wh.height = .Cells(nRowCnt, 5).Value
' 6列目から色.
aRect(nElementCnt).color.R = .Cells(nRowCnt, 6).Value
aRect(nElementCnt).color.G = .Cells(nRowCnt, 7).Value
aRect(nElementCnt).color.B = .Cells(nRowCnt, 8).Value
nElementCnt = nElementCnt + 1
End With
Next
End Sub
Mainルーチン内からSetupRecetルーチンをコール( ソースコードを見る )
Sub Main()
Dim cRenderSystem As RenderingSystem
Set cRenderSystem = New RenderingSystem
' Rectの格納場所を用意.
Dim aRect() As Rect
Dim nCnt As Integer
' 初期化処理をコール.
Call Initialize(cRenderSystem)
' rectシートから、Rectをセットアップ.
Call SetupRect(aRect)
' aRectの要素数に合わせてRenderingSystemのDrawRectをコール.
For nCnt = LBound(aRect) To UBound(aRect)
Call cRenderSystem.DrawRect(aRect(nCnt))
Next
' 終了処理をコール.
Call Terminate(cRenderSystem)
End Sub
この状態で、フレームバッファのサイズを400×300にして処理を実行してみると、図5のような結果が得られます。
いかがでしたでしょうか?これまで2回に渡り、メモリをクリアして単純な四角形だけを描画する仕組みをExcelで実装しました。ここまででもかなり長い道のりでしたが、回転もスケールもしない四角形を描画できたところであまり嬉しいことはありません。できれば自由に回転させたいですし、テクスチャを描画してみたいと思います。しかし、そのためにはこの仕組みを更に拡張し、スキャンライン( 横方向の1行 )内に、どの図形がどの面積で入っているかなどの複雑な判定を入れていくことになります。そして、これらの処理をすべてCPU側で行うことになるわけですが、アニメーションなどを行うと、こういった処理を全画面分毎フレーム行うことになり、かなり大きなコストがかかることになります。本来この辺りはシビアな話なのですが、今回のターゲットはPC上のソフトウェアですので、次回以降もあまり気にせずに実装したい機能ベースでお話を進めていきたいと思います。