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