魔塔之拯救白娘子 完整工程下載地址：
《魔塔之拯救白娘子》流程分析2：
⑤游戲界面鼠標點擊判斷以及自動尋路：
自動尋路的效果如下：

源碼如下：

Sub 游戲界面鼠標點擊判斷() Dim map(12, 12) As Integer Dim j As Integer Dim k As IntegerDim a As POINTSDim b As POINTS Dim m() As String '①先判斷當前是不是彈出對話窗口 If Running <> 1 Then Exit Sub If 戰斗開始標志 = True Then Exit Sub If 對話窗口顯示標志 = True Then Exit Sub If 商店對話窗口顯示標志 = True Then Exit Sub If 跳樓對話窗口顯示標志 = True Then Exit Sub '②設置一個鼠標點擊游戲范圍 If Xi.MouseKey(xgL_BUTTON) Then鼠標X坐標 = Xi.MouseX鼠標Y坐標 = Xi.MouseY ' '地圖XY坐標.mapX坐標(j) = j * 32 '地圖XY坐標.mapY坐標(j) = j * 32 'If 鼠標X坐標 = 32 Or 鼠標X坐標 > 32 And 鼠標X坐標 < 384 ThenIf 鼠標Y坐標 = 32 Or 鼠標Y坐標 > 32 And 鼠標Y坐標 < 384 Then'③根據鼠標點擊的坐標，判斷與角色所在的位置自動尋路終點坐標.x = Int(鼠標X坐標 / 32)自動尋路終點坐標.y = Int(鼠標Y坐標 / 32)自動尋路開始坐標.x = Int(男主角移動.y / 32)'這里要特別留意！自動尋路開始坐標.y = Int(男主角移動.x / 32)'這里要特別留意！'設置尋路開始坐標，終點坐標a.x = 自動尋路開始坐標.xa.y = 自動尋路開始坐標.yb.x = 自動尋路終點坐標.xb.y = 自動尋路終點坐標.y'點的是自己就退出判斷If 自動尋路終點坐標.x = 自動尋路開始坐標.x And 自動尋路終點坐標.y = 自動尋路開始坐標.y Then 自動尋路開啟標志 = False: Exit Sub自動尋路開啟標志 = True'獲得地圖數據'讀臨時地圖數據 (0)For j = 0 To 12 m = Split(地圖數據(j), ",") For k = 0 To 12 map(k, j) = m(k)Select Case map(k, j) Case 0, 2, 3, 4, 5, 7, 25 map(k, j) = 0'Case 6, 10 To 24, 26 To 199 ' 'map(k, j) = 1 Case Else map(k, j) = 1 End Select Next k Next j'④調用A星尋路 PathLength = 0If AStar(map, a, b) = 1 Then自動尋路成功標志 = True 'MsgBox "找到路徑":Else自動尋路成功標志 = False 'MsgBox "沒有路徑":End If' Form_尋路.ShowIf 自動尋路成功標志 = False Then 自動尋路開啟標志 = False: Exit Sub劃線計數器 = PathLength' Debug.Print "尋路長度：" & PathLength'劃線 ' For j = 0 To PathLength - 1 ' 'DrawRectFill AStarPath(j).x * 32, AStarPath(j).y * 32, AStarPath(j).x * 32 + 32, AStarPath(j).y * 32 + 32, xgGREEN ' DrawLine AStarPath(j).x * 32, AStarPath(j).y * 32, AStarPath(j).x * 32 + 32, AStarPath(j).y * 32 + 32, xgRED ' 'Debug.Print "移動路線：", "X: " & AStarPath(j).x, "Y: "; AStarPath(j).y'' 4.保存路徑的數組AStarPath中的路徑是從終點開始到起點結束的（倒序保存的），請根據自己的需要進行調整' '移動處理 ' 自動移動處理 (劃線計數器)' Next '自動尋路開啟標志 = False End IfEnd IfIf 鼠標X坐標 = 543 Or 鼠標X坐標 > 543 And 鼠標X坐標 < 613 ThenIf 鼠標Y坐標 = 462 Or 鼠標Y坐標 > 462 And 鼠標Y坐標 < 484 Then' If Running <> 1 Then Exit SubIf MsgBox("你是否要退出游戲，返回主菜單？", vbQuestion Or vbYesNo, Me.Caption) = vbYes ThenRunning = 9: 讀檔標志 = False: 判斷running狀態_初始化: BackPic.LoadGraph "image\魔塔背景\魔塔背景1.jpg", xgBLACKEnd IfEnd IfEnd IfIf 鼠標X坐標 = 543 Or 鼠標X坐標 > 543 And 鼠標X坐標 < 613 ThenIf 鼠標Y坐標 = 432 Or 鼠標Y坐標 > 432 And 鼠標Y坐標 < 454 Then'If Running <> 1 Then Exit Sub'立即手動存檔清除地圖上多余的主角寫臨時地圖數據 (地圖層號) ' 自動存檔 地圖層號, True游戲存檔 地圖層號, Truem = Split(地圖數據(游戲進度.J坐標), ",")m(游戲進度.K坐標) = 14地圖數據(游戲進度.J坐標) = m(0) & "," & m(1) & "," & m(2) & "," & m(3) & "," & m(4) & "," & m(5) & "," & m(6) & "," & m(7) & "," & m(8) & "," & m(9) & "," & m(10) & "," & m(11) & "," & m(12)'寫臨時地圖數據 (地圖層號)提示信息 = "游戲手動存檔成功！"End IfEnd IfEnd IfErase m()Erase map() End Sub

源碼中用到的A*尋路.bas 源碼：

'使用說明： ' 調用本模塊只需要操作模塊內的4個內容： ' 1.公共函數AStar：這個函數有三個參數，第一個參數是需要尋路二維數組，第二個參數是起點，第三個參數是終點 ' 返回1說明找到了路徑，返回0說明沒有找到路徑 ' ' 2.公共數組AStarPath：這個數組存放的是找到的路徑,路徑的長度存放在公共變量PathLength中 ' ' 3.公共變量PathLength：變量存的是路徑長度，遍歷回路的時候用這個變量更加方便。 ' ' 4.私有函數CreateAStarMap：這個函數只需要改兩個for循環中的if情況就行，根據你的需要更改。 ' 比如：在你設計的地圖數組map中，1代表通路 2代表障礙的話，可把相應的判斷改掉就行。 ' 如果你要多加障礙（比如1,2,3,4都是障礙），也可以多加elseif的情況。 ' ' '注意事項： ' 1.傳入的map數組必須是int類型的二維數組 ' 2.數組元素必須從0開始,比如：dim map (3,3) as Integer，不能是：dim map (1 to 3,1 to 3) as Integer ' 3.回路長度PathLength變量在下次尋路前請賦值為0 ' 4.保存路徑的數組AStarPath中的路徑是從終點開始到起點結束的（倒序保存的），請根據自己的需要進行調整 'Option ExplicitPrivate Const 障礙 As Integer = 0 Private Const 通道 As Integer = 1Public Type POINTSx As Integery As Integer End TypePrivate Type AStarNodepos As POINTS '該節點的坐標father As POINTSG As IntegerH As Integerstyle As Integer '類型，是否可行走 End TypePublic OpenNum As Integer '開啟列表中的總結點數-1 Public CloseNum As Integer '關閉列表中的總結點數-1Public OpenList() As AStarNode '開啟表 Public CloseList() As AStarNode '關閉表 Public AStarMap() As AStarNode '地圖'計算出來的地圖尺寸 Private minX As Integer Private minY As Integer Private maxX As Integer Private maxY As Integer'參數：要尋路的二維地圖,尋路起點,尋路終點'返回值：1找到路徑，路徑存在AStarPath中 0未找到路徑 Public AStarPath() As POINTS '路徑 Public PathLength As Integer '路徑長度 Public Function AStar(map() As Integer, startP As POINTS, endP As POINTS) As IntegerDim AstartP As AStarNode '起點Dim AendP As AStarNode '終點Dim p As POINTS '指針Dim ArrLength As Long '數組長度Dim minFP As AStarNode '最小F值的節點Dim i As Integer '找最小F值for循環的循環變量'只算一次，降低時間開銷minX = LBound(map, 1)maxX = UBound(map, 1)minY = LBound(map, 2)maxY = UBound(map, 2)ArrLength = (UBound(map, 1) - LBound(map, 1) + 1) * (UBound(map, 2) - LBound(map, 2) + 1) - 1ReDim OpenList(ArrLength) '確定最大范圍ReDim CloseList(ArrLength)ReDim AStarPath(ArrLength)'初始化OpenNum = -1: CloseNum = -1PathLength = 0AstartP.pos = startP '將傳進來的坐標轉換成AStar的節點類型AendP.pos = endPCreateAStarMap map, AstartP, AendP '根據游戲地圖創建本次尋路的A星地圖AddOpenList AStarMap(AstartP.pos.x, AstartP.pos.y) '將起點加入開啟表DoIf OpenNum = -1 Then AStar = 0: Exit Do '當開啟列表為空時，退出循環（沒有找到路徑）'把開啟列表中G+H值最小的點找出來（有多個相同最小值的話，找出靠前的那個）minFP = OpenList(0)For i = 0 To OpenNumIf minFP.G + minFP.H > OpenList(i).G + OpenList(i).H Then '找數組中最小數minFP = OpenList(i)End IfNext i'把這個點從開啟列表中刪除，加入到關閉列表DelOpenList minFPAddCloseList minFP'搜索該點的鄰居Call Neighbor_Search(minFP, 0, -1) '上Call Neighbor_Search(minFP, 0, 1) '下Call Neighbor_Search(minFP, -1, 0) '左Call Neighbor_Search(minFP, 1, 0) '右'這里是八方尋路，用不上可以直接注釋掉 ' Call Neighbor_Search(minFP, -1, -1) '上左 ' Call Neighbor_Search(minFP, 1, -1) '上右 ' Call Neighbor_Search(minFP, -1, 1) '下左 ' Call Neighbor_Search(minFP, 1, 1) '下右If CheckCloseNode(AendP) = True Then '如果終點在關閉列表中，就說明找到了通路，用回溯的方法記錄路徑AStar = 1'尋找回路p = AendP.posDoAStarPath(PathLength) = pPathLength = PathLength + 1p = AStarMap(p.x, p.y).father '指針移動If p.x = startP.x And p.y = startP.y Then Exit DoLoopExit FunctionEnd IfLoopAStar = 0'Debug.Print AStarMap(0, 0).H: Debug.Print AStarMap(1, 1).H End Function'根據游戲地圖創建AStar的尋路地圖 Private Sub CreateAStarMap(map() As Integer, startP As AStarNode, endP As AStarNode)Dim x As IntegerDim y As IntegerReDim AStarMap(maxX - minX, maxY - minY) '根據游戲地圖確定尋路地圖尺寸'生成尋路地圖For x = minX To maxXFor y = minY To maxYIf map(x, y) = 0 ThenAStarMap(x, y).style = 障礙AStarMap(x, y).G = 0 '初始化成0，到需要的時候再重新計算AStarMap(x, y).H = (Abs(x - endP.pos.x) + Abs(y - endP.pos.y)) * 10 '對于相同的起點和終點，H為定值，我們需要在這里一次性計算好(曼哈頓距離)AStarMap(x, y).pos.x = xAStarMap(x, y).pos.y = yElseIf map(x, y) = 1 ThenAStarMap(x, y).style = 通道AStarMap(x, y).G = 0AStarMap(x, y).H = (Abs(x - endP.pos.x) + Abs(y - endP.pos.y)) * 10AStarMap(x, y).pos.x = xAStarMap(x, y).pos.y = yEnd IfNext yNext xEnd Sub'參數：需要添加進來的節點（添加在線性表的尾部） Private Function AddOpenList(pos As AStarNode) As IntegerOpenNum = OpenNum + 1 '總節點數+1OpenList(OpenNum) = pos '添加節點End Function'參數：需要刪除的節點（刪除后，將線性表尾部節點補充到刪除后的空缺位置，為了減小時間復雜度） Private Function DelOpenList(pos As AStarNode) As IntegerDim t As AStarNode '臨時節點，用于做變量交換Dim c As AStarNode '臨時節點，用于清空對象Dim i As IntegerFor i = 0 To OpenNumIf OpenList(i).pos.x = pos.pos.x And OpenList(i).pos.y = pos.pos.y Then '找到要刪除的節點（目標節點）t = OpenList(OpenNum) 't指向開啟表中最后一個節點OpenList(OpenNum) = c '刪除最后一個節點OpenList(i) = t '把最后一個節點覆蓋到目標節點OpenNum = OpenNum - 1 '開啟表長度-1Exit For '結束不必要的循環End IfNext iEnd Function'參數：需要添加進來的節點（添加在線性表的尾部） Private Function AddCloseList(pos As AStarNode) As IntegerCloseNum = CloseNum + 1 '總節點數+1CloseList(CloseNum) = pos '添加節點End Function'確認傳入節點是否存在于開啟表中 Private Function CheckNode(node As AStarNode) As BooleanDim i As IntegerFor i = 0 To OpenNumIf OpenList(i).pos.x = node.pos.x And OpenList(i).pos.y = node.pos.y Then '找到了CheckNode = TrueExit FunctionEnd IfNext iCheckNode = FalseEnd Function'確認是否在關閉表里 Private Function CheckCloseNode(node As AStarNode) As BooleanDim i As LongFor i = 0 To CloseNumIf CloseList(i).pos.x = node.pos.x And CloseList(i).pos.y = node.pos.y Then '找到了CheckCloseNode = TrueExit FunctionEnd IfNext iCheckCloseNode = FalseEnd Function'功能： '更新開啟表中的G值 Private Sub UpdataG()Dim i As IntegerFor i = 0 To OpenNumIf OpenList(i).G <> AStarMap(OpenList(i).pos.x, OpenList(i).pos.y).G ThenOpenList(i).G = AStarMap(OpenList(i).pos.x, OpenList(i).pos.y).GEnd IfNext i End SubPrivate Sub Neighbor_Search(minFP As AStarNode, offsetX As Integer, offsetY As Integer)Dim AStep As Integer'越界檢測If minFP.pos.x + offsetX > maxX Or minFP.pos.x + offsetX < 0 Or minFP.pos.y + offsetY > maxY Or minFP.pos.y + offsetY < 0 Then Exit SubIf offsetX = 0 Or offsetY = 0 Then ' 設置單位花費AStep = 10ElseAStep = 14End If'如果該鄰居不是障礙并且不在關閉表中If AStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY).style <> 障礙 And CheckCloseNode(AStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY)) = False Then'AStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY).G = minFP.G + AStep '給G賦值If CheckNode(AStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY)) = True Then '存在于開啟表中If minFP.G + AStep < AStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY).G Then '如果走新路徑更短就更換父節點AStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY).G = minFP.G + AStepAStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY).father = minFP.posCall UpdataG '更新Openlist中的G值End IfElse '不存在于開啟表中'設置該鄰居的父節點為我們上面找到的最小節點（minFP）AStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY).father = minFP.pos'計算該點（鄰居）的G值AStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY).G = minFP.G + AStep'把該點加入開啟表中AddOpenList AStarMap(minFP.pos.x + offsetX, minFP.pos.y + offsetY)End IfEnd IfEnd Sub

總結

以上是生活随笔為你收集整理的魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~16开始游戏-自动寻路（A星算法）的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。