Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10 / 13315 ツリー ←次へ | 前へ→

【80898】VBAシューティングゲームの弾発射について SHUN 19/6/12(水) 21:48 質問[未読]
【80904】Re:VBAシューティングゲームの弾発射につい... 亀マスター 19/6/15(土) 21:21 回答[未読]
【80906】Re:VBAシューティングゲームの弾発射につい... SHUN 19/6/16(日) 20:15 お礼[未読]

【80898】VBAシューティングゲームの弾発射について
質問  SHUN  - 19/6/12(水) 21:48 -

引用なし
パスワード
   VBAでゲーム創作についての質問です。

以下のようなプログラムを組み、スペースキーで弾としての小さな円を発射させたいと
思ったのですが、
1.弾が自機の場所に関わらず同じ場所しか出ない、途中で止まる。
2.スペースキーを押している間、大量の色指定のない小さな円が生成される

といった問題点があります。

どのように修正したらよいでしょうか?


Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer

Sub 練習()

'初期設定

Dim p1 As Single, p2 As Single, s1 As Single, s2 As Single
Dim p3 As Single, p4 As Single, s3 As Single, s4 As Single

Dim crcx As Object, crc1 As Object

Dim bung As Boolean


p1 = 200
p2 = 200
s1 = 40
s2 = 40


ActiveSheet.Shapes.AddShape(msoShapeOval, p1, p2, s1, s2).Name = "circlex"
With ActiveSheet.Shapes("circlex")
  .Fill.ForeColor.RGB = vbBlue
  .Line.Visible = False
End With

Set crcx = ActiveSheet.Shapes("circlex")

bung = False

'メインループ

Do

'crcxを移動


If GetAsyncKeyState(39) <> 0 Then '右
 
crcx.Left = crcx.Left + 0.5

End If

If GetAsyncKeyState(37) <> 0 Then '左
    
crcx.Left = crcx.Left - 0.5

End If

'Enterキーで強制終了

If GetAsyncKeyState(13) <> 0 Then
 
crcx.Delete


Exit Do
  
End If

'crc1をy方向100まで発射

If GetAsyncKeyState(32) <> 0 Then

bung = True

End If

If bung = True Then

p3 = crcx.Left + 20
p4 = crcx.Top + 20
s3 = 10
s4 = 10

ActiveSheet.Shapes.AddShape(msoShapeOval, p3, p4, s3, s4).Name = "circle1"
With ActiveSheet.Shapes("circle1")
  .Fill.ForeColor.RGB = vbRed
  .Line.Visible = False
End With

Set crc1 = ActiveSheet.Shapes("circle1")

bung = False

crc1.Top = crc1.Top - 10

  If crc1.Top < 100 Then
  
  crc1.Delete
  
  End If

End If


'処理間隔を 0.01 秒に設定
Application.Wait [Now() + "0:00:00.01"]


Loop


End Sub

【80904】Re:VBAシューティングゲームの弾発射につ...
回答  亀マスター  - 19/6/15(土) 21:21 -

引用なし
パスワード
   >弾が自機の場所に関わらず同じ場所しか出ない
>スペースキーを押している間、大量の色指定のない小さな円が生成される

いずれも弾にcircle1という名前を付けて、それをもってコントロールしようとしているせいだと思われます。
スペースキーを押している間、
ActiveSheet.Shapes.AddShape(msoShapeOval, p3, p4, s3, s4).Name = "circle1"
で新しい弾を生成し続けますが、それ以降に
ActiveSheet.Shapes("circle1")
を使って参照するのは、最初に生成したcircle1だけなので、それ以降に色の設定をされない弾が生成される上、それらは移動しないということになるのでしょう。


>途中で止まる

これは
If crc1.Top < 100 Then
  crc1.Delete
End If
でそのように設定してるからではないですか?


対応方法ですが、弾を生成するたびにコレクションに追加し、弾の移動はFor Eachで回すようにすればいいでしょう。
最初に弾に色を付けるときだけは、コレクションの最大番号を取得して、それで指定するとか、コレクションに追加するときにキーを設定してそれで指定するとか。


あと、質問とは関係ないですが、インデントが揃ってないので非常に読みにくいです。階層構造に応じたインデントを設定するようにしましょう。
p1とかp2とかの変数名が何のことを指しているのかわかりにくいのも課題ですね。

【80906】Re:VBAシューティングゲームの弾発射につ...
お礼  SHUN  - 19/6/16(日) 20:15 -

引用なし
パスワード
   ありがとうございます。

コレクションとかfor eachとか、実は今一つ分かっていないので、おそらく根本的に基礎力が足りてないのですね。
修行して出直してきます。

10 / 13315 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free