frmpathanalyst.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmPathAnalyst 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "路径分析"
   ClientHeight    =   4320
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6885
   Icon            =   "frmPathAnalyst.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4320
   ScaleWidth      =   6885
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton btnAddPathPoint 
      Caption         =   "添加"
      Height          =   435
      Left            =   3555
      TabIndex        =   8
      Top             =   3360
      Width           =   1380
   End
   Begin VB.CommandButton btnRemovePathPoint 
      Caption         =   "移除"
      Height          =   435
      Left            =   5100
      TabIndex        =   7
      Top             =   3360
      Width           =   1380
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取消"
      Height          =   435
      Left            =   5100
      TabIndex        =   6
      Top             =   3795
      Width           =   1380
   End
   Begin VB.CommandButton Command1 
      Caption         =   "分析"
      Height          =   435
      Left            =   3555
      TabIndex        =   5
      Top             =   3795
      Width           =   1380
   End
   Begin VB.Frame Frame1 
      Caption         =   "功能选择"
      Height          =   825
      Left            =   30
      TabIndex        =   2
      Top             =   3405
      Width           =   3270
      Begin VB.OptionButton optTSP 
         Caption         =   "旅行商"
         Height          =   300
         Left            =   1800
         TabIndex        =   4
         Top             =   315
         Width           =   1275
      End
      Begin VB.OptionButton optPath 
         Caption         =   "最佳路径"
         Height          =   300
         Left            =   360
         TabIndex        =   3
         Top             =   330
         Value           =   -1  'True
         Width           =   1155
      End
   End
   Begin VB.Frame Frame7 
      Caption         =   "站点信息"
      Height          =   3315
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6870
      Begin MSComctlLib.ListView lvwPathPoints 
         Height          =   3075
         Left            =   45
         TabIndex        =   1
         Top             =   180
         Width           =   6720
         _ExtentX        =   11853
         _ExtentY        =   5424
         View            =   3
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         FullRowSelect   =   -1  'True
         GridLines       =   -1  'True
         HotTracking     =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   0
         NumItems        =   4
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Text            =   "序号"
            Object.Width           =   2540
         EndProperty
         BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   1
            Text            =   "结点标识"
            Object.Width           =   2540
         EndProperty
         BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   2
            Text            =   "x坐标"
            Object.Width           =   2540
         EndProperty
         BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   3
            Text            =   "y坐标"
            Object.Width           =   2540
         EndProperty
      End
   End
End
Attribute VB_Name = "frmPathAnalyst"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public bAddPoint As Boolean

Private Sub btnAddPathPoint_Click()
    bAddPoint = True
    frmMain.SuperMap1.Action = scaSelect
End Sub

Private Sub btnRemovePathPoint_Click()
    If lvwPathPoints.SelectedItem Is Nothing Then
        MsgBox "请选中一条记录"
    Else
        lvwPathPoints.ListItems.Remove lvwPathPoints.SelectedItem.Index
    End If
End Sub

Private Sub Command1_Click()
    Dim objNetworkAnalystEx As soNetworkAnalystEx
    Dim objpoints As New soPoints
    Dim i As Integer
    Dim objGeoLineM As soGeoLineM
    Dim objstyle As New soStyle
    If frmMain.SuperMap1.Layers(1).Dataset.Type = scdNetwork Then
        If lvwPathPoints.ListItems.Count < 2 Then
            MsgBox "至少要选择两个点"
        Else
            Set objNetworkAnalystEx = frmMain.SuperAnalyst1.NetworkAnalyst
            Set objNetworkAnalystEx.NetworkSetting.NetworkDataset = frmMain.SuperMap1.Layers(1).Dataset
            objNetworkAnalystEx.OutputDatasourceAlias = frmMain.SuperWorkspace1.Datasources(1).Alias
            For i = 1 To lvwPathPoints.ListItems.Count
                objpoints.Add2 lvwPathPoints.ListItems(i).SubItems(2), lvwPathPoints.ListItems(i).SubItems(3)
            Next i
            If optPath.Value Then   '最佳路径分析
                Set objGeoLineM = objNetworkAnalystEx.Path(objpoints, scpFPTMinEdgesSum)
            Else   '旅行商分析
                Set objGeoLineM = objNetworkAnalystEx.TSPPath(objpoints)
            End If
            
            objstyle.PenColor = vbBlue
            frmMain.SuperMap1.TrackingLayer.ClearEvents
            If Not objGeoLineM Is Nothing Then
                frmMain.SuperMap1.TrackingLayer.AddEvent objGeoLineM, objstyle, ""
            End If
            frmMain.SuperMap1.TrackingLayer.Refresh
        End If
    End If
    Set objpoints = Nothing
    Set objstyle = Nothing
End Sub

Private Sub Command2_Click()
    Me.Hide
End Sub