ABで避けゲーを作る

前回までのあらすじ：とうとう憎き敵が現れた。しかし、その敵はどこからどう見てもただの四角形であった。

9.そろそろ見栄えよく

とりあえず動くようにはなったのですからもうそろそろ白背景にまるとしかくから綺麗なビットマップに切り替えてもいいころでしょう。

まず背景を用意します。

何かに似てるって？気にしない気にしない。
キャラクターが明るい黄色を基調としたデザインなので暗い色の背景にします。
もちろん大きさはゲーム画面のサイズと同じにしておきます。

次にキャラクター画像を用意します。「マスク」と呼ばれる白黒画像もつけておきます。

本家サイトではマスク画像を自動生成するなんてエレガントな技が出ていましたが、こちとらエレガントでもエレファントでもいいからとにかくゲームが作れればいいという立場なので、あらかじめマスクを作って横にくっつけておきます。これで片方だけなくしてしまうということもありません。

本家に倣ってグローバルな変数とか定数を用意してしまいましょう。
今更気付いたんですが、文字列変数ってちょっと日本語としておかしいですよね。関係ないけど。

'背景画像
Const FileName_Back="back.bmp"
Dim hBackDC As DWord
Dim hBackBmp As DWord

'キャラクター画像
Const FileName_Chara="chara.bmp"
Const CHARA_PIXEL_X=32
Const CHARA_PIXEL_Y=32
Dim hCharaDC As DWord
Dim hCharaBmp As DWord

こうして無難な命令ばかりを使っていればいかにActiveBasicであろうと反抗することは…（略
続いて、ビットマップを読み込みます。こちらも本家を真似ています。

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
    Dim hDC As DWord

    'ビットマップ読み込むぞ！チョエーイ！
    hBackBmp=LoadImage(GetModuleHandle(0),FileName_Back,IMAGE_BITMAP,0,0,LR_LOADFROMFILE or LR_DEFAULTSIZE)
    If hBackBmp=0 Then
        MessageBox(hMainWnd,FileName_Back&"の読み込みに失敗","Error",MB_OK or MB_ICONEXCLAMATION)
        PostQuitMessage(0)
    End If
    hCharaBmp=LoadImage(GetModuleHandle(0),FileName_Chara,IMAGE_BITMAP,0,0,LR_LOADFROMFILE or LR_DEFAULTSIZE)
    If hCharaBmp=0 Then
        MessageBox(hMainWnd,FileName_Chara&"の読み込みに失敗","Error",MB_OK or MB_ICONEXCLAMATION)
        PostQuitMessage(0)
    End If

    hDC=GetDC(hMainWnd)

    'デバイスコンテキストを作るぞ！うぇーい！
    hBackDC=CreateCompatibleDC(hDC)
    hCharaDC=CreateCompatibleDC(hDC)

    'DCにBMPを選択。うぐぅ…
    SelectObject(hBackDC,hBackBmp)
    SelectObject(hCharaDC,hCharaBmp)

    ReleaseDC(hMainWnd,hDC)

    MoveWindow(hMainWnd, 0, 0, GAMEWIDTH + GetSystemMetrics(SM_CXDLGFRAME) * 2, GAMEHEIGHT + GetSystemMetrics(SM_CYDLGFRAME) * 2 + GetSystemMetrics(SM_CYCAPTION), 0)
    Dim dwDummy As DWord
    CreateThread(ByVal 0,0,AddressOf(MainOperation),0,0,VarPtr(dwDummy))
End Sub

いつか見たコードもさりげなく混じってます。
後始末もしなければ。

Sub MainWnd_Destroy()
    DeleteDC(hBackDC)
    DeleteObject(hBackBmp)
    DeleteDC(hCharaDC)
    DeleteObject(hCharaBmp)

    fffab_DestroyObjects()
    PostQuitMessage(0)
End Sub

さあ、ビットマップは読み込めるようになりました。
どんなゲームになっ…えっ、このままじゃ変わらないって？読み込んだビットマップを使う命令を入れないと表示してくれないって？
わかりましたよ書けばいいんでしょう書けば！

Function PaintBackground()
    '背景描画
    Dim hDC As DWord
    hDC = GetDC(hMainWnd)
    BitBlt(hDC, 0, 0, GAMEWIDTH, GAMEHEIGHT, hBackDC, 0, 0, SRCCOPY)
    ReleaseDC(hMainWnd, hDC)
End Function

Function PaintMyChara()
    'マイキャラ描画
    Dim hDC As DWord
    hDC = GetDC(hMainWnd)
    BitBlt(hDC, MyCharaX-CHARA_PIXEL_X/2, MyCharaY-CHARA_PIXEL_Y/2, CHARA_PIXEL_X, CHARA_PIXEL_Y, hCharaDC, 32, 0, SRCPAINT)
    BitBlt(hDC, MyCharaX-CHARA_PIXEL_X/2, MyCharaY-CHARA_PIXEL_Y/2, CHARA_PIXEL_X, CHARA_PIXEL_Y, hCharaDC, 0, 0, SRCAND)
    ReleaseDC(hMainWnd, hDC)
End Function

Function PaintEnemy()
    '敵キャラ描画
    Dim n As Long
    Dim hDC As DWord
    hDC = GetDC(hMainWnd)
    '１号からEnemyNumber号までを描くのだ！
    For n = 1 To EnemyNumber
        'とげとげｎ号を描くのだ！
        BitBlt(hDC, Enemy[n].X-CHARA_PIXEL_X/2, Enemy[n].Y-CHARA_PIXEL_Y/2, CHARA_PIXEL_X, CHARA_PIXEL_Y, hCharaDC, 32, 32, SRCPAINT)
        BitBlt(hDC, Enemy[n].X-CHARA_PIXEL_X/2, Enemy[n].Y-CHARA_PIXEL_Y/2, CHARA_PIXEL_X, CHARA_PIXEL_Y, hCharaDC, 0, 32, SRCAND)
    Next
    ReleaseDC(hMainWnd, hDC)
End Function

見栄えが良くなったサンプル(39.8kilobyte)

マスクがなかったら？(07/08/07)

今回当たり前のようにマスクをつけましたが、マスクがなかったらどうなるか、試してみましょう。

単純にマスクをつける文を削除した場合です。
色が変ですね。

背景と同じ方法で描画した場合です。
キャラの周りに四角い枠ができています。

マスクだけ描画した場合です。
なんだか幽霊みたいですね。

そんなわけで、マスクが必要というわけです。

続く