Excel VBA質問箱 IV

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

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


13 / 75261 ←次へ | 前へ→

【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

34 hits

【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 お礼[未読][NEW]

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