前回までのあらすじ:とうとう憎き敵が現れた。しかし、その敵はどこからどう見てもただの四角形であった。
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) '1号からEnemyNumber号までを描くのだ! For n = 1 To EnemyNumber 'とげとげn号を描くのだ! 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
マスクがなかったら?(07/08/07)
今回当たり前のようにマスクをつけましたが、マスクがなかったらどうなるか、試してみましょう。
単純にマスクをつける文を削除した場合です。
色が変ですね。
背景と同じ方法で描画した場合です。
キャラの周りに四角い枠ができています。
マスクだけ描画した場合です。
なんだか幽霊みたいですね。
そんなわけで、マスクが必要というわけです。