form1.frm

初学A*算法的很好源码

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "A* 算法VB版演示"
   ClientHeight    =   5175
   ClientLeft      =   45
   ClientTop       =   450
   ClientWidth     =   6615
   FillColor       =   &H00800080&
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5175
   ScaleWidth      =   6615
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   2000
      Left            =   4680
      Top             =   840
   End
   Begin VB.CommandButton Command3 
      Caption         =   "逐步"
      Height          =   495
      Left            =   5280
      TabIndex        =   5
      Top             =   240
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "寻找"
      Height          =   495
      Left            =   4080
      TabIndex        =   4
      Top             =   240
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Caption         =   "地图设置"
      Height          =   615
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3855
      Begin VB.OptionButton Option3 
         Caption         =   "路障"
         Height          =   255
         Left            =   2640
         TabIndex        =   3
         Top             =   240
         Value           =   -1  'True
         Width           =   1095
      End
      Begin VB.OptionButton Option2 
         Caption         =   "目标位置"
         Height          =   255
         Left            =   1440
         TabIndex        =   2
         Top             =   240
         Width           =   1095
      End
      Begin VB.OptionButton Option1 
         Caption         =   "开始位置"
         Height          =   255
         Left            =   240
         TabIndex        =   1
         Top             =   240
         Width           =   1095
      End
   End
   Begin VB.Label lb 
      BackColor       =   &H0000FF00&
      Height          =   375
      Index           =   0
      Left            =   120
      TabIndex        =   6
      Top             =   840
      Width           =   375
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'--------------------------------------------------------------------
' 常用用数值定义
'--------------------------------------------------------------------
Const mapW = 18, mapH = 15, mapSz = 350 '水平10格,垂直10格,大小180象素
Dim blColor, stColor, tgColor, nwColor, opColor, clColor, phColor
'--------------------------------------------------------------------
' 地图属性
'--------------------------------------------------------------------
Private Type map
    RUN As Boolean  '是否可通过
    OCW As Integer  '默认 0,开启 1,关闭 10,为路径 3
    F As Integer
    G As Integer
    H As Integer
End Type

'--------------------------------------------------------------------
' 坐标
'--------------------------------------------------------------------
Private Type mapXY
    X As Integer
    Y As Integer
End Type

'--------------------------------------------------------------------
' 用到的变量
'--------------------------------------------------------------------
Dim lbList(mapW * mapH + 1) As mapXY    'lable控件的坐标
Dim onOpenList As Integer
Dim openList(mapW * mapH + 1) As mapXY  '开启列表
Dim start As mapXY                      '开始位置
Dim target As mapXY                     '目标位置
Dim tgBf As mapXY                       '记录找到目标的父节点
Dim parent As mapXY                     '储存父节点
Dim parentList(mapW + 1, mapH + 1) As mapXY '列表
Dim pathLc(mapW * mapH + 1) As mapXY    '路径位置
Dim pathLcNumber As Integer
Dim blnPath As Boolean                  '判断是否找到路径

Dim Obstacle As Boolean                 '是否有墙
Dim blnStep As Boolean                  '判断是否为步行
Dim reSetColor As Boolean               '是否从新设置颜色

Dim mapList(mapW + 1, mapH + 1) As map  '记录地图属性
'--------------------------------------------------------------------
' 常用变量
'--------------------------------------------------------------------
Dim X, Y, i, j, a, b, t, tg As Integer

Private Sub Command2_Click() '查找
    Call findPath
End Sub

Private Sub Command3_Click() '单步查找
    If blnStep Then
        
    Else
        blnStep = True
        Call findPath
    End If
'    Form2.Left = Form1.Left + Form1.Width
'    Form2.Top = Form1.Top
'    Form2.Height = Form1.Height
'    Form2.Show 1
End Sub
    
Private Sub Form_load()
Me.Show
Me.Left = 100
Me.Top = 100
'--------------------------------------------------------------------
' 颜色
'--------------------------------------------------------------------
blColor = RGB(128, 128, 128)        '背景
stColor = RGB(0, 185, 0)        '开始
tgColor = RGB(255, 0, 0)        '目标
nwColor = RGB(0, 0, 255)        '障碍
opColor = RGB(0, 138, 138)         '开启
clColor = RGB(205, 108, 34)     '关闭
phColor = RGB(255, 255, 0)      '路径

Option1.ForeColor = stColor
Option2.ForeColor = tgColor
Option3.ForeColor = nwColor

    lb(0).Width = mapSz: lb(0).Height = mapSz
    lb(0).Left = 100: lb(0).Top = 800: lb(0).Visible = False     '设置lb(0)的属性
'--------------------------------------------------------------------
' 增加方块
'--------------------------------------------------------------------
    i = 1
    For Y = 1 To mapH
    For X = 1 To mapW
'--------------------------------------------------------------------
' 增加方块
'--------------------------------------------------------------------
        Load Form1.lb(i) '增加方块
        
        t = X + mapW * (Y - 1)
        lbList(t).X = X: lbList(t).Y = Y 'lb的X,Y坐标
        lb(i).Left = lb(0).Left + mapSz * (X - 1) + 10 * X
        lb(i).Top = lb(0).Top + mapSz * (Y - 1) + 10 * Y
        lb(i).Visible = True
        lb(i).BackColor = blColor
               
'--------------------------------------------------------------------
' 设置地图属性
'--------------------------------------------------------------------
        mapList(X, Y).RUN = True    '设置路径为可通过
        mapList(X, Y).OCW = 0       '设置路径为开启
        i = i + 1
    Next
    Next
'--------------------------------------------------------------------
' 设置窗口大小
'--------------------------------------------------------------------
    If mapW * mapSz + 300 >= Form1.Width Then
        Form1.Width = lb(t).Left + mapSz + 200
    End If
    
    Form1.Height = lb(t).Top + mapSz + 600
'--------------------------------------------------------------------
' 设置开始位置
'--------------------------------------------------------------------
    start.X = 3: start.Y = mapH / 2
    lb(findIndex(start.X, start.Y)).BackColor = stColor
'--------------------------------------------------------------------
' 设置目标颜色
'--------------------------------------------------------------------
    target.X = mapW - 2: target.Y = mapH / 2
    lb(findIndex(target.X, target.Y)).BackColor = tgColor
'--------------------------------------------------------------------
' 设置障碍物
'--------------------------------------------------------------------
    X = mapW / 2
    For Y = 4 To mapH - 3
        mapList(X, Y).RUN = False
        parent.X = X
        parent.Y = Y
        lb(findIndex(parent.X, parent.Y)).BackColor = nwColor
    Next
End Sub
'Private Sub lb_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Private Sub lb_Click(Index As Integer)
    If reSetColor Then '判断最后设置路径的颜色
'--------------------------------------------------------------------
' 设置地图属性
'--------------------------------------------------------------------
        i = 1
        For Y = 1 To mapH
        For X = 1 To mapW
            If lb(i).BackColor = phColor _
            Or lb(i).BackColor = opColor _
            Or lb(i).BackColor = clColor Then lb(i).BackColor = blColor '把路径换回背景色
            
            i = i + 1
        Next
        Next
        
        reSetColor = False
    End If

    
    X = lbList(Index).X
    Y = lbList(Index).Y   '得到lb控件的
    If Option1.Value Then   '选择开始
        lb(findIndex(start.X, start.Y)).BackColor = blColor '还原
        lb(Index).BackColor = stColor                     '设置开始
        
        mapList(X, Y).RUN = True '将止路径设置可行
        start.X = X '记录开始位置
        start.Y = Y
    ElseIf Option2.Value Then   '选择目标
        lb(findIndex(target.X, target.Y)).BackColor = blColor '还原
        lb(Index).BackColor = tgColor                     '设置目标
        
        mapList(X, Y).RUN = True '将止路径设置可行
        target.X = X    '记录目标位置
        target.Y = Y
    ElseIf Not (X = start.X And Y = start.Y) And Not (X = target.X And Y = target.Y) Then '当不是开始也不是目标位置时才设置为障碍
        If lb(Index).BackColor = nwColor Then    '是否已为障碍
            lb(Index).BackColor = blColor