CANDERA開発者コラム
第13回 VBAテクスチャ描画システムを拡張する(4)
～アルファブレンド(後編)～

#define N_SWIMAGE_TYPE_RGB (0)
#define N_SWIMAGE_TYPE_RGBA (1)
typedef struct _SSWImage {
    uint32_t unType;

    uint32_t unWidth;
    uint32_t unHeight;

    uint32_t unPadding;

    // 16Bytes.

    uint8_t* pData;
} SSWImage;

' -----------------------------------
' Types(抜粋)'
' 変更前.
Public Type ColorRGB
    R As Integer
    G As Integer
    B As Integer
End Type

color As ColorRGB

' 変更後.
Public Type ColorRGBA
	R As Integer
	G As Integer
	B As Integer
	A As Integer
End Type

color As ColorRGBA

' -----------------------------------
' RenderingSystem(抜粋)'
' 変更前.
Private m_color As ColorRGB
Function nGetColor() As ColorRGB
Dim sColor As ColorRGB

' 変更後.
Private m_color As ColorRGBA
Function nGetColor() As ColorRGBA
Dim sColor As ColorRGBA

' -----------------------------------
' ImageCache(抜粋)'
' 変更前.
Dim sColor As ColorRGB

' 変更後.
Dim sColor As ColorRGBA

Public Type SWImageDraw
    id As Integer
    imageID As Integer
    pos As Position
    blendType As Integer ' このプロパティを追加.
End Type

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

            ' 5列目はBlend設定.
            ' ここを追加！.
            aImageDraw(nElementCnt).blendType = .Cells(nRowCnt, 5).Value
            
            nElementCnt = nElementCnt + 1
        End With
    Next nRowCnt

End Sub

Sub LoadImage(ByRef rImageStructure As SWImageStructure, ByRef szFileName As String)
    Dim fd As Integer
    Dim nSize As Long
    Dim aBuff() As Byte
    
    Dim nCount As Integer
    nCount = 0

	' 乗算済み変換に必要な変数.
    Dim nRowCnt As Long: nRowCnt = 0
    Dim nColCnt As Long: nColCnt = 0
        
    Dim nPixelPosition As Long: nPixelPosition = 0
    
    Dim nBytesPerPixel As Integer: nBytesPerPixel = 4
        
    fd = FreeFile
    
    ' 対象のファイルを開く.
    Open szFileName For Binary Access Read As #fd
    
    ' 配列の確保.
    ReDim aBuff(IMAGE_STRUCTURE_HEADER_SIZE)
    
    ' データの読み込み.
    aBuff = InputB(IMAGE_STRUCTURE_HEADER_SIZE, fd)
    
    ' 最初の4Bytesはフォーマット番号だが、0か1にしかなり得ないので先頭の1Byteのみで良い.
    rImageStructure.format = aBuff(nCount)
    nCount = nCount + 4

    If IMAGE_FORMAT_TYPE_RGB = rImageStructure.format Then
        nBytesPerPixel = 3
    End If
    
    ' 次の4Bytesが幅( uint32_t ).
    rImageStructure.width = aBuff(nCount) + 255 * aBuff(nCount + 1) + 65535 * aBuff(nCount + 2) + 16711680 * aBuff(nCount + 3)
    nCount = nCount + 4
    
    ' その次の4Bytesが高さ( uint32_t ).
    rImageStructure.height = aBuff(nCount) + 255 * aBuff(nCount + 1) + 65535 * aBuff(nCount + 2) + 16711680 * aBuff(nCount + 3)
    
    ' その次はPaddingなので、気にしない.
    rImageStructure.padding = 0
    
    ' データ部分のサイズを取得.
    nSize = LOF(fd) - IMAGE_STRUCTURE_HEADER_SIZE
    
    ' データ部分のサイズに合わせて配列のサイズを変更.
    ReDim rImageStructure.data(nSize)
    
    ' データの読み込み.
    rImageStructure.data = InputB(nSize, fd)

	' 乗算済みに変換する.
	' ここを追加！.
	' アルファチャネルが存在している場合.
    If 4 = nBytesPerPixel Then
        For nRowCnt = 0 To rImageStructure.height - 1
            For nColCnt = 0 To rImageStructure.width - 1
                nPixelPosition = nBytesPerPixel * (nColCnt + nRowCnt * rImageStructure.width)

                ' Alpha.
                Dim nAlpha As Integer: nAlpha = rImageStructure.data( nPixelPosition + 3 )
                Dim nWork As Long: nWork = 0

                ' R.
                nWork = CLng(CLng(rImageStructure.data(nPixelPosition)) * nAlpha / 255)
                rImageStructure.data(nPixelPosition) = CInt(nWork)
                ' G.
                nWork = CLng(CLng(rImageStructure.data(nPixelPosition + 1)) * nAlpha / 255)
                rImageStructure.data(nPixelPosition + 1) = CInt(nWork)
                ' B.
                nWork = CLng(CLng(rImageStructure.data(nPixelPosition + 2)) * nAlpha / 255)
                rImageStructure.data(nPixelPosition + 2) = CInt(nWork)

            Next nColCnt
        Next nRowCnt
    End If
    
    ' 読みたての場合はCacheは存在しない.
    rImageStructure.posUV.x = -1
    rImageStructure.posUV.y = -1
    
    ' 対象のファイルを閉じる.
    Close #fd
    
End Sub

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 ColorRGBA
    
    ' ピクセル辺り何Bytesか( デフォルトは4 ).
    Dim nBytesPerPixel As Integer: nBytesPerPixel = 4

    ' Alpha値を格納するための変数.
    Dim nAlpha As Integer: nAlpha = 255

    ' 描画面の色を格納しておくための変数.
    Dim nFBColor As Long: nFBColor = 0
    Dim sFBColor As ColorRGBA
    
    ' ただし、画像フォーマットが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)
                
                sColor.R = rImageStructure.data(nPixelPosition)
                sColor.G = rImageStructure.data(nPixelPosition + 1)
                sColor.B = rImageStructure.data(nPixelPosition + 2)

                
                ' この形式では色はRGB(A)の順番で格納されている.
                If 4 = nBytesPerPixel Then
                    ' アルファチャネルが格納されている場合はその値を取得.
                    nAlpha = rImageStructure.data(nPixelPosition + 3)

                    ' RGBチャネルについては乗算済み.
                    ' 係数は、ONE, ONE - SrcA.
                    ' 現在のピクセルの値を取得.
                    ' 描画面のAlphaは1なのでAlpha値の計算は不要.
                    nFBColor = .Cells(nRowStart + nRowCnt, nColStart + nColCnt).Interior.color
                    sFBColor.R = nFBColor Mod 256
                    sFBColor.G = CInt(Int(nFBColor / 256) Mod 256)
                    sFBColor.B = CInt(Int(nFBColor / 65536))

                    sColor.R = CInt(CLng(sColor.R) + CLng(sFBColor.R) * (255 - nAlpha) / 255)
                    sColor.G = CInt(CLng(sColor.G) + CLng(sFBColor.G) * (255 - nAlpha) / 255)
                    sColor.B = CInt(CLng(sColor.B) + CLng(sFBColor.B) * (255 - nAlpha) / 255)
                End If

                .Cells(nRowStart + nRowCnt, nColStart + nColCnt).Interior.color = RGB(sColor.R, sColor.G, sColor.B)
            Next nColCnt
        Next nRowCnt
    End With
End Sub

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)

        Dim bBlend As Boolean: bBlend = False

        ' まずBlend設定を見る.
        If 1 = aImageDraw(nCnt).blendType Then
            ' 一旦はBlendすると仮定.
            bBlend = True
        End If

        ' 次に対象の画像の状態を見る.
        If bBlend Then
            If IMAGE_FORMAT_TYPE_RGB = aImage(aImageDraw(nCnt).imageID).image.format Then
                ' Blendしたいと言っているものの、3チャネルしかない画像はBlendしようとしても意味がない.
                bBlend = False
            End If
        End If

        If bBlend Then
            Call cRenderSystem.DrawImage(aImageDraw(nCnt).pos, aImage(aImageDraw(nCnt).imageID).image)
        Else
            Call cRenderSystem.DrawCachedImage(aImageDraw(nCnt).pos, aImage(aImageDraw(nCnt).imageID).image)
        End If
        
    Next
    
    ' 終了処理をコール.
    Call Terminate(cRenderSystem, cVramSystem)
End Sub