パソコン活用研究5番街（Visual
Basic、Excel(VBA)、BASIC プログラミング研究）
ゲーム Apple Catch
１ Apple Catchについて
Visual Basicで作成したゲーム第１作目です。
シンプルな落ちものゲームで、落下してくるリンゴを下の人間を操作してキャッチするゲームです。
リンゴは途中で虫に食われて、虫に変化してしまうことがあります。リンゴをキャッチすると10点、
誤って虫をキャッチすると-10点です。リンゴを10個キャッチできずに落とすとゲームオーバーです。
ゲームのダウンロード＝＞applecatch020.zip
上記ファイルにはソース(Visual Basic4.0用）と実行ファイルが含まれています。
なお、上記実行ファイルの実行にはＶＢ４のランタイムライブラリ(vb40032.dll,
vb4jp.dll)が必要です。
これらのランタイムライブラリがない場合はVectorの下記サイトにいくつかランタイムライブラリがあります
のでダウンロードしてお使い下さい。
http://www.vector.co.jp/vpack/filearea/win/util/runtime/index.html
ゲームイメージ
２ Apple Catchプログラム
若干、プログラムについて説明しておきます。非常にシンプルな作りです。
コードはゲーム作成時に参考になりそうな部分だけ抜粋して説明しますので、コード全体は
上記のファイルをダウンロードして、ソースコードを見て下さい。
（１） メインフォームのデザイン画面
フォームは3つありますが、ゲームの骨格を成すメインフォームのみ説明します。
（２） ゲーム全体の仕様
リンゴは１７個で、1〜17までナンバリングします。ナンバー1のリンゴは一番左端、ナンバー17の
リンゴは右端を落下していくことにしています。
リンゴは一定の確率で登場します。
下まで落下したリンゴは、一定の確率で再登場します。
リンゴは一定の確率で毛虫に変化します。
変数
x, y りんご（または 毛虫）の座標
a リンゴの表示、非表示 0 非表示（非登場） 1 表示（登場）
b リンゴの状態 0 リンゴ １ 毛虫
u 人間の位置（X座標）
v 人間の位置の変化量（X座標）
fapple 落下したリンゴの数
sc 得点
（３） 宣言部
リンゴをキャッチした時にWaveファイルを鳴らします。そのために、sndplaysoundという
waveファイルを鳴らすためのAPI関数を宣言します。
Private Declare Function sndplaysound Lib "winmm.dll" Alias "sndPlaySoundA"
(ByVal df As String, ByVal dw As Long) As Long |
（４） ゲームスタート
「メニュー」−「ゲームスタート」を選択した時に呼ばれるプロシージャです。
各種パラメータの初期化をしています。
Private Sub start_Click()
Form1.Cls
Line (240, 320)-(300, 350), QBColor(4), B
u = 240: v = 0
Image4.Visible = True
fapple = 0
Randomize
label2.Visible = False
text2.Text = ""
For i = 0 To 17
a(i) = 0: b(i) = 0: Image1(i).Visible = False
y(i) = 50
Next
text1.Text = ""
sc = 0
Timer1.Enabled = True
End Sub |
（５）人間の操作
人間キャラクターはマウス（で画面上のコマンドボタンをクリック）でもキーボードでも
操作できるようにしてあります。
コマンドボタンまたはキーボードを押した時に、人間の変化の方向を設定します。
あくまでも、変化の方向（左か、止まるか、右）を設定するだけで、人間を実際に
移動することはしていません。人間の移動はタイマーイベントの発生時に行って
います。
コマンドボタンによる操作
コマンドボタンをクリックすると、人間の位置の変化量を設定します。
Private Sub Command1_Click()
v = -30
End Sub
Private Sub Command2_Click()
v = 0
End Sub
Private Sub Command3_Click()
v = 30
End Sub |
キーボードによる操作
キーボードでも操作できるようにしてあります。
KeyAsciiに押されたキーのキーコードが取得されますので、キーコードを判定し、
"1"(&H31) なら左への変化（v=-30)
"2"(&H32) なら止まる(v=0)
"3"(&H33)なら右への変化(v=30)
を設定します。
Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case &H31
v = -30
Case &H32
v = 0
Case &H33
v = 30
End Select
End Sub |
（６） キャラクターの移動、当たり判定
キャラクターの移動や、当たり判定などはタイマーイベント発生時(Timer1_Timerプロシージャ)に処理
をしています。
Timer_Timerプロシージャでは、まず人間キャラクターの移動と表示を行います。
Private Sub Timer1_Timer()
'箱を背景（明るい白）で描画=箱を消す
QBColor(15)
Line (u, 320)-(u + 60, 350), QBColor(15), B
'以下は人間キャラクターの移動と、人間キャラ、箱の再描画
u = u + v
If u < 0 Then u = 0
If u > 480 Then u = 480
'uは箱の左端の座標。人間キャラのx座標位置はu+9にしている
Image4.Move u + 9, 351
Line (u, 320)-(u + 60, 350), QBColor(4), B
|
次に、りんご（または毛虫）と箱の当たり判定を行います。
りんごのx座標方向はの位置は30ピクセル単位で管理しています。
リンゴは１７個で、1〜17までナンバリングしており、ナンバー1のリンゴは一番左端、ナンバー17の
リンゴは右端を落下していくことにしています。
まず、箱の位置がリンゴの1〜17のどの位置にあるかを調べます。リンゴのx座標方向は30ピクセル
単位で管理しているので、
n = u/30
でnに箱の位置が、リンゴのどのナンバーの位置にあるかを代入します。・・・(A)
n番目のリンゴが箱の位置にあれば y(n) = 320 サブルーチンS3にとんで当たり処理をします。・・・(B)
箱の大きさはリンゴ２個ぶんなので、n+1番目のリンゴも同様に、当たり判定を行います。・・・(C)
'リンゴ（毛虫）との当たり判定 ・・・(A)
'リンゴのx座標方向の位置は30ピクセル単位で管理している
n = u / 30
'n番目のリンゴが箱の位置にあれば、サブルーチンS3にとんで当たり判定を行う ・・(B)
'a（リンゴの表示、非表示パラメータ）,b（リンゴ、毛虫のパラメータ）を初期化し、リンゴを非表示
If y(n) = 320 Then
i = n: GoSub S3
a(n) = 0: b(n) = 0: Image1(n).Visible = False: y(n) = 50
End If
'箱の大きさはリンゴ２個ぶんなので、n+1番目のリンゴも同様に、当たり判定を行う･･･(C)
If y(n + 1) = 320 Then
i = n + 1: GoSub S3
a(n + 1) = 0: b(n + 1) = 0: Image1(n + 1).Visible = False: y(n + 1) = 50
End If |
次に、リンゴの移動、リンゴ−＞毛虫への変化処理、リンゴが下まで落ちきった時の処理をします。
L2: ではリンゴが１０個以上落ちると（fapple>10)ゲーム終了の処理をします。
'リンゴの移動、表示の処理
'a()は0がりんご非表示、1で登場 b()は0がりんご、1は虫
For i = 1 To 17
'リンゴが非表示の場合はサブルーチンS1にとび、リンゴ登場か否かの処理をする
If a(i) = 0 Then GoSub S1
If a(i) = 0 Then GoTo L1
'リンゴがまだ毛虫でない場合は、サブルーチンS2にとび、毛虫になるかどうかの処理をする
If b(i) = 0 And y(i) < 290 Then GoSub S2
y(i) = y(i) + 30
Image1(i).Move x(i), y(i)
'リンゴが箱の位置まで落ちた場合の、当たり判定と処理
If y(i) = 320 And (x(i) = u Or x(i) = u + 30) Then GoSub S3
'リンゴが下まで落ちきった時の処理
If y(i) > 340 Then
GoSub s4
a(i) = 0: b(i) = 0: Image1(i).Visible = False
End If
L1:
Next
GoTo L2
'
' ＜この間にサブルーチンS1, S2,S3,S4が挿入されています＞
'
'リンゴが１０個以上落ちると（fapple>10)ゲーム終了の処理をします
L2:
If fapple >= 10 Then
label2.Visible = True
Timer1.Enabled = False
Form2.Show
If Form2.Text3.Visible = True Then
Form2.text1.SetFocus
Else
Form2.text1.SetFocus
End If
End If
End Sub
|
非表示（非登場）のリンゴを表示（登場）させるかどうかの処理のルーチン。
約8%(1/12)の確率で、リンゴを再登場させます。
'非表示（非登場）のリンゴを表示（登場）させるかどうかの処理のルーチン
S1:
If Rnd(1) * 12 < 1 Then
a(i) = 1: b(i) = 0: x(i) = i * 30: y(i) = 50: Image1(i).Picture = Image1(0).Picture
Image1(i).Visible = True
End If
Return |
リンゴを毛虫にするかどうかの処理のルーチンです。
約14%(1/7)の確率で毛虫になります。従って、毛虫にならずリンゴのままで下まで落ちる確率は30%弱に
なります。
'リンゴを毛虫にするかどうかの処理のルーチン
S2:
If Rnd(1) * 7 < 1 Then
b(i) = 1: Image1(i).Picture = Image2.Picture
End If
Return
|
当たり判定の処理ルーチンです。
リンゴをキャッチしたときは+10点、毛虫だった場合は-10点します。
'当たり判定の処理ルーチン
'ここで、箱がリンゴ（毛虫）をキャッチしたときは、API関数sndplaysoundをコールして
'Waveファイルを鳴らしています。
S3:
If b(i) = 0 Then
sc = sc + 10
result = sndplaysound("catch.wav", &H1)
ElseIf b(i) = 1 Then
sc = sc - 10
result = sndplaysound("hit.wav", &H1)
End If
text1.Text = Str$(sc)
a(i) = 0: b(i) = 0: Image1(i).Visible = False: y(i) = 50
Return |
リンゴが下に落ちきった時の処理ルーチンです。
fapple（箱でキャッチできずに下まで落ちてしまったリンゴの数）を+1して、Text2テキストボックスに
失敗した数を * で表示します。
'リンゴが下まで落ちきった時の処理ルーチン
s4:
If b(i) = 0 Then
fapple = fapple + 1
text2.Text = text2.Text + "*"
End If
Return |
３ あとがき
随所に、まだ旧BASIC流が残っていますねえ。進化しはじめたばかりという感じ。
TopPage/Visual Basic&Excel活用研究目次