Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1486 / 76734

←次へ　｜　前へ→


	【80898】VBAシューティングゲームの弾発射について

ＳＨＵＮ - 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

6 hits

▼

【80898】VBAシューティングゲームの弾発射について ＳＨＵＮ 19/6/12(水) 21:48