| |
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
