form1.frm

vb实现最短路径Dijkstra算法

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "Dijkstra's algorithm to find Shortest Path"
   ClientHeight    =   4725
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   7905
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   315
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   527
   StartUpPosition =   2  'CenterScreen
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   540
      Top             =   660
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label lblURL 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H0000FFFF&
      Caption         =   "http://www.geocities.com/emu8086/vb/"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   2205
      MouseIcon       =   "Form1.frx":014A
      MousePointer    =   99  'Custom
      TabIndex        =   5
      Top             =   4485
      Width           =   3495
   End
   Begin VB.Label lblFromTo 
      Alignment       =   2  'Center
      BackColor       =   &H0080FFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "From: ?  To: ?"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   5370
      TabIndex        =   4
      Top             =   0
      Width           =   2310
   End
   Begin VB.Label lblShapeCapUpper 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "lblShapeCapUpper"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   177
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   240
      Index           =   0
      Left            =   3090
      TabIndex        =   3
      Top             =   2925
      Visible         =   0   'False
      Width           =   2010
   End
   Begin VB.Label lblShapeCap 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "lblShapeCap"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   177
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   240
      Index           =   0
      Left            =   3675
      TabIndex        =   2
      Top             =   3435
      Visible         =   0   'False
      Width           =   1365
   End
   Begin VB.Label lblLineCap 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "lblLineCap"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   177
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   240
      Index           =   0
      Left            =   1365
      TabIndex        =   1
      Top             =   3375
      Visible         =   0   'False
      Width           =   1125
   End
   Begin VB.Line arrDown 
      BorderColor     =   &H000000FF&
      BorderWidth     =   2
      Index           =   0
      Visible         =   0   'False
      X1              =   187
      X2              =   211
      Y1              =   286
      Y2              =   274
   End
   Begin VB.Line arrUp 
      BorderColor     =   &H0000FF00&
      BorderWidth     =   2
      Index           =   0
      Visible         =   0   'False
      X1              =   186
      X2              =   212
      Y1              =   265
      Y2              =   272
   End
   Begin VB.Shape aDot 
      BackColor       =   &H00FF00FF&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H0000FF00&
      FillColor       =   &H00FFFF00&
      Height          =   60
      Index           =   0
      Left            =   3345
      Shape           =   3  'Circle
      Top             =   4050
      Visible         =   0   'False
      Width           =   60
   End
   Begin VB.Label lblID 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "id#"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   177
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00808080&
      Height          =   210
      Left            =   90
      TabIndex        =   0
      Top             =   15
      Width           =   210
   End
   Begin VB.Line ln 
      BorderWidth     =   2
      Index           =   0
      Visible         =   0   'False
      X1              =   180
      X2              =   302
      Y1              =   27
      Y2              =   168
   End
   Begin VB.Shape shp 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00000000&
      BorderWidth     =   5
      Height          =   870
      Index           =   0
      Left            =   1200
      Top             =   1650
      Visible         =   0   'False
      Width           =   1710
   End
   Begin VB.Menu mnuFile 
      Caption         =   "File"
      Begin VB.Menu mnuSave 
         Caption         =   "Save"
      End
      Begin VB.Menu mnuLoad 
         Caption         =   "Load"
      End
      Begin VB.Menu mnu0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuLoadDiakstaFile 
         Caption         =   "dijkstra.tzr - for find short path"
      End
      Begin VB.Menu mnuLoadAllPathFile 
         Caption         =   "allPath.tzr - for find all paths"
      End
   End
   Begin VB.Menu mnuFind 
      Caption         =   "Find!"
      Begin VB.Menu mnuFindShortPath 
         Caption         =   "Find Short Path"
      End
      Begin VB.Menu mnuFindAllPaths 
         Caption         =   "Find All Paths"
      End
   End
   Begin VB.Menu mnuEditor 
      Caption         =   "Editor"
      Begin VB.Menu mnuAddShape 
         Caption         =   "Add Shape"
         Begin VB.Menu mnuAddRect 
            Caption         =   "Rectangle"
         End
         Begin VB.Menu mnuAddSquare 
            Caption         =   "Square"
         End
         Begin VB.Menu mnuAddElipse 
            Caption         =   "Elipse"
         End
         Begin VB.Menu mnuAddCircle 
            Caption         =   "Circle"
         End
      End
      Begin VB.Menu mnuChangeShape 
         Caption         =   "Change Shape"
         Begin VB.Menu mnuChangeRect 
            Caption         =   "Rectangle"
         End
         Begin VB.Menu mnuChangeSquare 
            Caption         =   "Square"
         End
         Begin VB.Menu mnuChangeElipse 
            Caption         =   "Elipse"
         End
         Begin VB.Menu mnuChangeCircle 
            Caption         =   "Circle"
         End
         Begin VB.Menu mnu1 
            Caption         =   "-"
         End
         Begin VB.Menu mnuChangeBackColor 
            Caption         =   "Change Back Color"
         End
         Begin VB.Menu mnuChangeBorderColor 
            Caption         =   "Change Border Color"
         End
         Begin VB.Menu mnu2 
            Caption         =   "-"
         End
         Begin VB.Menu mnuChangeSize 
            Caption         =   "Change Size"
         End
      End
      Begin VB.Menu mnuJoin 
         Caption         =   "Join"
         Begin VB.Menu mnuJoinLine 
            Caption         =   "Line"
         End
         Begin VB.Menu mnuJoinArrow 
            Caption         =   "Arrow"
         End
      End
      Begin VB.Menu mnuDelete 
         Caption         =   "Delete"
         Begin VB.Menu mnuDeleteLine 
            Caption         =   "Arrow / Line"
         End
         Begin VB.Menu mnuDeleteBlock 
            Caption         =   "Block"
         End
      End
      Begin VB.Menu addCaption 
         Caption         =   "Add Caption"
         Begin VB.Menu mnuAddCaptionToLine 
            Caption         =   "Arrow / Line"
         End
         Begin VB.Menu mnuAddCaptionToBlock 
            Caption         =   "Add Caption To Block"
         End
         Begin VB.Menu mnuAddCaptionUpperToBlock 
            Caption         =   "Block (upper)"
         End
         Begin VB.Menu mnuAddCaptionLowerToBlock 
            Caption         =   "Block (lower)"
         End
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'  ==========================================
'  Dijkstra's algorithm to find Shortest Path
'  ==========================================
'
' E.W. Dijkstra is a Dutch professor in Computer
' Science, who did a lot of research in graphs.
'
' Dijkstra's algorithm is of use when working with
' directional graphs. It constructs the shortest path
' between a starting-node and a goal-node.
' It is assumed that every link between two nodes
' has a certain cost, and this algorithm finds the
' path between the two given nodes with the lowest cost.
'
' The idea of this VB project was to show the
' work of this algorithm in a visual way.
'
'    Screen-shot: dijkstra.gif
'
'
'    Visit my Homepage:
'    http://www.geocities.com/emu8086/vb/
'
'
'    Last Update: Saturday, July 20, 2002
'
'
'    Copyright 2002 Alexander Popov Emulation Soft.
'               All rights reserved.
'        http://www.geocities.com/emu8086/



Option Explicit

Dim distX As Single
Dim distY As Single

Public WithEvents theBlockCollection As myBlockCollection
Attribute theBlockCollection.VB_VarHelpID = -1
Public WithEvents theLineCollection As myLineCollection
Attribute theLineCollection.VB_VarHelpID = -1

Private Sub Form_Load()
    MAX_SHAPE = 0
    DRAGGED_SHAPE = -1
    SELECTED_SHAPE = -1
    PREV_SELECTED_SHAPE = -1

    Set theBlockCollection = New myBlockCollection
    Set theLineCollection = New myLineCollection
    
    MAX_LINE = 0
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DRAGGED_SHAPE = -1
    
    update_from_to
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

Private Sub lblLineCap_MouseDown(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Form_MouseDown Button, Shift, X / Screen.TwipsPerPixelX + lblLineCap(index).Left, Y / Screen.TwipsPerPixelY + lblLineCap(index).Top
End Sub

Private Sub lblLineCap_MouseMove(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Form_MouseMove Button, Shift, X / Screen.TwipsPerPixelX + lblLineCap(index).Left, Y / Screen.TwipsPerPixelY + lblLineCap(index).Top
End Sub

Private Sub lblLineCap_MouseUp(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Form_MouseUp Button, Shift, X / Screen.TwipsPerPixelX + lblLineCap(index).Left, Y / Screen.TwipsPerPixelY + lblLineCap(index).Top
End Sub

Private Sub lblShapeCap_MouseDown(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Form_MouseDown Button, Shift, X / Screen.TwipsPerPixelX + lblShapeCap(index).Left, Y / Screen.TwipsPerPixelY + lblShapeCap(index).Top
End Sub

Private Sub lblShapeCap_MouseMove(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)