Excel VBA質問箱 IV

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

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


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

1500 / 76734

←次へ　｜　前へ→


	【80884】オートシェイプ辺り判定：円と回転する長方形

ＳＨＵＮ - 19/6/6(木) 19:58 -


	引用なし

	パスワード

VBAで作るゲームの質問です。

自分で操作する円形のオートシェイプと、自動で回転する長方形のオートシェイプの
当たり判定はどうすればよいでしょうか？？

円と円は三平方で、円と非回転の長方形は１辺との距離判定でクリアしましたが、
回転となるとわからなくなりました。

よろしくお願いいたします。

ちなみに円と円の衝突は以下のようにつくりました。

Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
'円の作成
Sub MakeCircle()

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

With Selection
　p1 = 50　 '左端からの位置
　p2 = 200　'上端からの位置
　s1 = 20　 '図形の横幅
　s2 = 20　 '図形の縦幅
　p3 = 200
　p4 = 200
　s3 = 40
　s4 = 40
　
End With

'自機を作成
ActiveSheet.Shapes.AddShape(msoShapeOval, p1, p2, s1, s2).Name = "circle1"
With ActiveSheet.Shapes("circle1")
　　'図形の背景色青
　　.Fill.ForeColor.RGB = vbBlue
　　'図形の枠線を無しに設定
　　.Line.Visible = False
End With

'敵機を作成
ActiveSheet.Shapes.AddShape(msoShapeOval, p3, p4, s3, s4).Name = "circle2"
With ActiveSheet.Shapes("circle2")
　　.Fill.ForeColor.RGB = vbRed
　　.Line.Visible = False
End With

End Sub

'円の移動
　Sub MoveCircle()

　Dim crc1 As Object
　Dim crc2 As Object
　
　Dim x1 As Single
　Dim x2 As Single
　Dim y1 As Single
　Dim y2 As Single
　
　Dim rx As Single

　'オブジェクト変数に図形を入れる
　Set crc1 = ActiveSheet.Shapes("circle1")
　Set crc2 = ActiveSheet.Shapes("circle2")

　Do
　
　If GetAsyncKeyState(40) <> 0 Then '下
　　　　If crc1.Top < 300 Then
　　　　crc1.Top = crc1.Top + 10
　　　　Else
　　　　crc1.Top = crc1.Top
　　　　End If
　End If
　
　If GetAsyncKeyState(38) <> 0 Then '上
　　　　If crc1.Top > 40 Then
　　　　crc1.Top = crc1.Top - 10
　　　　Else
　　　　crc1.Top = crc1.Top
　　　　End If
　End If
　
　If GetAsyncKeyState(39) <> 0 Then '右
　　　　If crc1.Left < 300 Then
　　　　crc1.Left = crc1.Left + 10
　　　　Else
　　　　crc1.Left = crc1.Left
　　　　End If
　End If
　
　If GetAsyncKeyState(37) <> 0 Then '左
　　　　If crc1.Left > 40 Then
　　　　crc1.Left = crc1.Left - 10
　　　　Else
　　　　crc1.Left = crc1.Left
　　　　End If
　End If
　　　　
　'1 ～ 4 の乱数を発生
　Randomize
　
　rd = Int(Rnd * 4 + 1)

　'得られた乱数によって敵機ランダム移動
　Select Case rd

　Case 1
　　If crc2.Top < 280 Then
　　crc2.Top = crc2.Top + 20
　　Else
　　crc2.Top = crc2.Top
　　End If

　Case 2
　　If crc2.Top > 40 Then
　　crc2.Top = crc2.Top - 20
　　Else
　　crc2.Top = crc2.Top
　　End If
　　
　Case 3
　　If crc2.Left < 280 Then
　　crc2.Left = crc2.Left + 20
　　Else
　　crc2.Left = crc2.Left
　　End If
　　
　Case Else
　　If crc2.Left > 40 Then
　　crc2.Left = crc2.Left - 20
　　Else
　　crc2.Left = crc2.Left
　　End If

　End Select

　'当たり判定：ゲームオーバー
　x1 = crc1.Left + crc1.Width / 2
　y1 = crc1.Top + crc1.Height / 2
　x2 = crc2.Left + crc2.Width / 2
　y2 = crc2.Top + crc2.Height / 2
　rx = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
　
　　If rx < 30 Then

　　
　　MsgBox "ゲームオーバー"
　　
　　crc1.Delete
　　crc2.Delete
　　
　　
　　Exit Do
　　
　　End If
　
　
　'Enterでゲーム終了

　　If GetAsyncKeyState(13) <> 0 Then
　　　　
　　crc1.Delete
　　crc2.Delete
　　
　　Exit Do
　　
　　End If

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

　Loop
　

　End Sub

7 hits

▼

【80884】オートシェイプ辺り判定：円と回転する長方形 ＳＨＵＮ 19/6/6(木) 19:58