pointlist.cls

航空最短路径探测

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "PointList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public HeadPoint As PointItem
Public TailPoint As PointItem

Private Sub Class_Initialize()
    Set HeadPoint = Nothing
    Set TailPoint = Nothing
End Sub

Private Sub Class_Terminate()
ClearList
End Sub
Public Sub ClearList()
 Dim n As PointItem
 While Not HeadPoint Is Nothing
   Set n = HeadPoint
   Set HeadPoint = HeadPoint.BackPoint
   Set n = Nothing
 Wend
End Sub

Public Function HasNodes() As Boolean
  HasNodes = Not HeadPoint Is Nothing
End Function

Public Sub DisplayList()
    Dim n As PointItem
    Set n = HeadPoint
    While Not n Is Nothing
     Debug.Print "X:" & Str(n.x) & "   Y:" & Str(n.y)
     Set n = n.BackPoint
    Wend
End Sub

Public Sub RemovePoint(pt As PointItem)
Dim n As PointItem
Set n = HeadPoint
If n Is pt Then
  Set HeadPoint = HeadPoint.BackPoint
  pt.Status = PointItemStatus.STATUSCLOSE
 Exit Sub
End If
While Not n Is Nothing
  If pt Is n.BackPoint Then
   Set n.BackPoint = pt.BackPoint
   pt.Status = PointItemStatus.STATUSCLOSE
   Exit Sub
End If
   Set n = n.BackPoint
Wend
MsgBox "该状态点不存在!"
End Sub

Sub InsertPoint(pt As PointItem, Hn As Integer)
Select Case pt.Status
 Case PointItemStatus.STATUSNEW
  pt.K = Hn
 Case PointItemStatus.STATUSOPEN
  If pt.K > Hn Then pt.K = Hn
 Case PointItemStatus.STATUSCLOSE
  If pt.h > Hn Then
   pt.K = Hn
  Else
  pt.K = pt.h
 End If
End Select
pt.h = Hn
pt.Status = PointItemStatus.STATUSOPEN

Dim n As PointItem
Dim n1 As PointItem
Set n = HeadPoint
If HeadPoint Is Nothing Then
 Set HeadPoint = pt
 Else
 'Set TailPoint.BackPoint = n
   If n.K > pt.K Then
     Set pt.BackPoint = n
     Set HeadPoint = pt
     Exit Sub
   End If
  Set n1 = n.BackPoint
  While Not n1 Is Nothing
    If n1.K > pt.K Then
     Set n.BackPoint = pt
     Set pt.BackPoint = n1
     Exit Sub
    End If
   Set n = n.BackPoint
   Set n1 = n.BackPoint
Wend
    Set n.BackPoint = pt
   Set TailPoint = pt
 End If
End Sub
Sub TransferList(List2 As PointList)
  Set List2 = New PointList
  Set List2.HeadPoint = HeadPoint
  Set List2.TailPoint = TailPoint
  Set HeadPoint = Nothing
  Set TailPoint = Nothing
End Sub

Function GetMinK() As Integer
If Me.HasNodes Then
 GetMinK = HeadPoint.K
Else
MsgBox "当前列表中没有状态节点!"
GetMinK = -1
End If
End Function

Function GetMinPoint() As PointItem
 Dim pt As PointItem
 If Me.HasNodes Then
   Set pt = HeadPoint
 Set GetMinPoint = pt
Else
 MsgBox "状态点队列为空!"
Set GetMinPoint = Nothing
 End If
End Function