VB 超简易迷宫 代码
发布网友
发布时间：2024-10-22 11:56
共2个回答
热心网友
时间：2024-10-22 18:31
Private Declare Function IntersectRect Lib "user32" (lpDestRECT As RECT, lpSrc1RECT As RECT, lpSrc2RECT As RECT) As Long
Private Type RECT
X1 As Long
Y1 As Long
X2 As Long
Y2 As Long
End Type
Dim xyStart As RECT '定义小人开始所在区域
Dim xyEnd As RECT '定义小人走出迷宫所在区域，用来判断是否成功
Dim spRECT(12) As RECT '我这里只有13个shape画的墙，用来记录所有墙覆盖的区域
Dim menRECT As RECT '小人覆盖的区域
Const bu As Long = 10 '定义小人移动的步长
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim temp As RECT
Select Case KeyCode
Case vbKeyUp
menRECT.Y1 = menRECT.Y1 - bu
menRECT.Y2 = menRECT.Y2 - bu
If zq(menRECT) Then spMen.top = spMen.top - bu
Case vbKeyDown
menRECT.Y1 = menRECT.Y1 + bu
menRECT.Y2 = menRECT.Y2 + bu
If zq(menRECT) Then spMen.top = spMen.top + bu
Case vbKeyLeft
menRECT.X1 = menRECT.X1 - bu
menRECT.X2 = menRECT.X2 - bu
If zq(menRECT) Then spMen.left = spMen.left - bu
Case vbKeyRight
menRECT.X1 = menRECT.X1 + bu
menRECT.X2 = menRECT.X2 + bu
If zq(menRECT) Then spMen.left = spMen.left + bu
End Select
menRECT.X1 = spMen.left
menRECT.Y1 = spMen.top
menRECT.X2 = spMen.left + spMen.Width
menRECT.Y2 = spMen.top + spMen.Height
If IntersectRect(temp, menRECT, xyEnd) > 0 Then
MsgBox "抵达终点了"
End If
End Sub
Private Sub Form_Load()
xyStart.X1 = 0 '开始的位置你自己定义
xyStart.Y1 = 0
xyStart.X2 = 360
xyStart.Y2 = 360
xyEnd.X1 = Me.ScaleWidth - 360 '结束的位置你自己定义
xyEnd.Y1 = 0
xyEnd.X2 = Me.ScaleWidth
xyEnd.Y2 = 360
Me.AutoRedraw = True
Line (xyStart.X1, xyStart.Y1)-(xyStart.X2, xyStart.Y2), vbYellow, BF '开始的地方画方框标记
Line (xyEnd.X1, xyEnd.Y1)-(xyEnd.X2, xyEnd.Y2), vbGreen, BF '结束的地方画方框标记
spMen.Shape = 3 'spmen是SHAPE控件表示人，用圆形表示
spMen.Width = 255: spMen.Height = 255 '人物大小
spMen.top = (xyStart.Y2 - xyStart.Y1 - spMen.Height) / 2 '让小人在开始位置居中
spMen.left = (xyStart.X2 - xyStart.X1 - spMen.Width) / 2
menRECT.X1 = spMen.left '记录开始小人的区域
menRECT.Y1 = spMen.top
menRECT.X2 = spMen.left + spMen.Width
menRECT.Y2 = spMen.top + spMen.Height
For i = 0 To 12 '记录开始时所有墙的区域
spRECT(i).X1 = sp(i).left
spRECT(i).Y1 = sp(i).top
spRECT(i).X2 = sp(i).left + sp(i).Width
spRECT(i).Y2 = sp(i).top + sp(i).Height
Next
End Sub
Private Function zq(Men As RECT) As Boolean
'判断是否撞墙并且没有出窗体的界限，超出界限返回假
zq = True
Dim temp As RECT
For i = 0 To 12
If IntersectRect(temp, Men, spRECT(i)) > 0 Then
zq = False
Exit Function
End If
Next
If Men.X1 < 0 Then zq = False: Exit Function
If Men.X2 > Me.ScaleWidth Then zq = False: Exit Function
If Men.Y1 < 0 Then zq = False: Exit Function
If Men.Y2 > Me.ScaleHeight Then zq = False: Exit Function
End Function
热心网友
时间：2024-10-22 18:28
每点一个键运动之前，把小人的坐标备份为x，y。如果小人运动后的坐标与边框重合，就令其限坐标为备份的坐标，否则为运动后应有的坐标。
dim prex,prey
prex=xiaoren.x
prey=xiaoren.y
(这里省略移动的代码）
if xiaoren.坐标 在 线.坐标内 then '这里可以用”点到线段两端距离等于线段距离“实现！！
x=prex
y=pre.y
else
ehd if
加点处可定义为函数（应该是这么叫吧，就是那个sub），然后call它就行了，这样更方便一点。
