frmmain.frm

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

VERSION 5.00
Object = "{02BEE3A6-4264-45B0-93C8-76FBBA329150}#5.2#0"; "SuperLegend.ocx"
Object = "{A61255F7-0A20-431C-86CE-78C14314BE9E}#5.2#0"; "SuperWkspManager.ocx"
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{19C64102-BC0F-4C56-89B2-C4865179A52C}#5.2#0"; "SUPERA~1.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "网络分析"
   ClientHeight    =   6705
   ClientLeft      =   150
   ClientTop       =   840
   ClientWidth     =   10605
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6705
   ScaleWidth      =   10605
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   6135
      Left            =   2115
      TabIndex        =   0
      Top             =   480
      Width           =   8415
      _Version        =   327682
      _ExtentX        =   14843
      _ExtentY        =   10821
      _StockProps     =   160
      Appearance      =   1
   End
   Begin SuperLegendLib.SuperLegend SuperLegend1 
      Height          =   2895
      Left            =   45
      TabIndex        =   1
      Top             =   3720
      Width           =   1980
      _Version        =   327682
      _ExtentX        =   3492
      _ExtentY        =   5106
      _StockProps     =   132
      Appearance      =   1
   End
   Begin SuperAnalystLib.SuperAnalyst SuperAnalyst1 
      Left            =   8220
      Top             =   60
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   3345
      Top             =   3285
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin MSComDlg.CommonDialog cmdOpen 
      Left            =   4365
      Top             =   4380
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton btnViewEntire 
      Caption         =   "全幅"
      Height          =   420
      Left            =   5535
      TabIndex        =   8
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnPan 
      Caption         =   "平移"
      Height          =   420
      Left            =   4545
      TabIndex        =   7
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnZoomout 
      Caption         =   "缩小"
      Height          =   420
      Left            =   3555
      TabIndex        =   6
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnZoomin 
      Caption         =   "放大"
      Height          =   420
      Left            =   2565
      TabIndex        =   5
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnSelect 
      Caption         =   "选择"
      Height          =   420
      Left            =   1575
      TabIndex        =   4
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开数据源"
      Height          =   420
      Left            =   0
      TabIndex        =   3
      Top             =   15
      Width           =   1575
   End
   Begin SuperWkspManagerLib.SuperWkspManager SuperWkspManager1 
      Height          =   3255
      Left            =   15
      TabIndex        =   2
      Top             =   450
      Width           =   2040
      _Version        =   327682
      _ExtentX        =   3598
      _ExtentY        =   5741
      _StockProps     =   0
   End
   Begin VB.Menu menu_NetworkAnalyst 
      Caption         =   "网络分析"
      Begin VB.Menu menu_PathAnalyst 
         Caption         =   "路径分析"
      End
      Begin VB.Menu menu_AllocateAnalyst 
         Caption         =   "资源分配"
      End
      Begin VB.Menu menu_LocationsAllocate 
         Caption         =   "选址分区"
      End
      Begin VB.Menu menu_Setting 
         Caption         =   "设置"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'===========================SuperMap Objects 示范程序==================================
'1.程序说明：示范SuperAlalyst提供的一些网络分析功能，包括最佳路径分析、旅行商分析、资源分配、
'   选址分区等。
'2.数据说明：可以自己选择打开一个带网络数据集的sdbplus数据。
'3.使用说明：
'   (1)点击“打开数据源”，打开一个数据源。
'   (2)点击“网络分析”->“设置”，弹出网络分析的设置对话框，设置了“网络分析基本参数”后就可以
'      进行最佳路径和旅行商分析，设置了“中心点设置”后就可以进行资源分配和选址分区分析。
'   (3)点击“网络分析”->“路径分析”，弹出路径分析对话框，在这个对话框通过选择网络图层上的结点
'      可以把结点信息添加到分析列表中，然后选择相应的分析类型，就可以进行分析了，分析结果会高亮
'      显示在地图窗口中。
'======================================================================================
Option Explicit

Private Sub btnPan_Click()
    SuperMap1.Action = scaPan
End Sub

Private Sub btnSelect_Click()
    SuperMap1.Action = scaSelect
End Sub

Private Sub btnViewEntire_Click()
    SuperMap1.ViewEntire
End Sub

Private Sub btnZoomin_Click()
    SuperMap1.Action = scaZoomIn
End Sub

Private Sub btnZoomout_Click()
    SuperMap1.Action = scaZoomOut
End Sub

Private Sub Command1_Click()
    Dim strname As String
    Dim objds As soDataSource
    With cmdOpen
        .FileName = ""
        .CancelError = False
        .DialogTitle = "打开数据源"
        .Filter = "(*.sdb)|*.sdb"
        .ShowOpen
        strname = .FileName
    End With
    If strname <> "" Then
        Set objds = SuperWorkspace1.OpenDataSource(strname, PathToName(strname), sceSDBPlus, False)
        If objds Is Nothing Then
            MsgBox "打开数据源失败"
        Else
            SuperWkspManager1.Refresh
        End If
    End If
End Sub

Private Sub Form_Load()
    SuperMap1.Connect SuperWorkspace1.Handle
    SuperLegend1.Connect SuperMap1.Handle
    SuperWkspManager1.Connect SuperWorkspace1.Handle
    SuperAnalyst1.Connect SuperWorkspace1.Handle
    
    menu_AllocateAnalyst.Enabled = False
    menu_LocationsAllocate.Enabled = False
    menu_PathAnalyst.Enabled = False
    menu_Setting.Enabled = False
End Sub

Public Function PathToName(ByVal strPath As String) As String
'=====================================================
'自定义函数,将文件全路径名转化为文件名(无路径名,无扩展名)
'=====================================================
      Dim nLength As Integer      '字符串长度
      Dim i As Integer
      Dim strTemp As String
      Dim strTemp1 As String
      Dim nPosition As Integer
      
      nPosition = 999
      If InStr(strPath, ".") <> 0 Then
            strTemp = Left(strPath, Len(strPath) - 4)
      Else
            strTemp = strPath
      End If
      
      nLength = Len(strTemp)
      For i = Len(strPath) To 1 Step -1
               If Mid$(strTemp, i, 1) = "\" Then
                     nPosition = i
                     Exit For
               End If
      Next
       If nPosition = 999 Then
            PathToName = strTemp
       Else
            PathToName = Right(strTemp, nLength - nPosition)
       End If
End Function

Private Sub Form_Unload(Cancel As Integer)
    SuperLegend1.Disconnect
    SuperMap1.Close
    SuperMap1.Disconnect
    SuperWkspManager1.Disconnect
    SuperAnalyst1.Disconnect
    SuperWorkspace1.Close
End Sub



Private Sub menu_AllocateAnalyst_Click()
    frmAllocate.Show vbModal, Me
End Sub

Private Sub menu_LocationsAllocate_Click()
    frmSetting.Hide
    frmLocationsAllocate.Show vbModal, Me
End Sub

Private Sub menu_PathAnalyst_Click()
    frmSetting.Hide
    frmPathAnalyst.Show vbModeless, Me
End Sub

Private Sub menu_Setting_Click()
    frmSetting.Show vbModeless, Me
End Sub

Private Sub SuperLegend1_Modified()
    SuperMap1.Refresh
End Sub


Private Sub PointInfoToListview(objgeopoint As soGeoPoint, lvwPoints As ListView)  '点信息加入到listview
    Dim objListItem As ListItem
    If lvwPoints.ListItems.Count > 0 Then
        Set objListItem = lvwPoints.ListItems.Add _
        (, , CInt(lvwPoints.ListItems.Item(lvwPoints.ListItems.Count).Text) + 1)
    Else
        Set objListItem = lvwPoints.ListItems.Add(, , 1)
    End If
    objListItem.SubItems(1) = objgeopoint.ID
    objListItem.SubItems(2) = objgeopoint.x
    objListItem.SubItems(3) = objgeopoint.y
End Sub

Private Sub SuperMap1_GeometrySelected(ByVal nSelectedGeometryCount As Long)
    Dim objrc As soRecordset
    Dim objgeoline As soGeoLine
    Dim objgeopoint As soGeoPoint
    Dim objListItem As ListItem
    If frmSetting.Visible Then  '如果可见
        If SuperMap1.selection.Count > 0 Then
            Select Case frmSetting.iAction
                Case 1:  '网络障碍分析中取点和边
                    Select Case SuperMap1.selection.Dataset.Type
                        Case scdPoint:
                            Set objrc = SuperMap1.selection.ToRecordset(False)
                            objrc.MoveFirst
                            Set objgeopoint = objrc.GetGeometry
                            PointInfoToListview objgeopoint, frmSetting.lvwBarrierNodes
                        Case 4:
                            Set objrc = SuperMap1.selection.ToRecordset(False)
                            objrc.MoveFirst
                            Set objgeoline = objrc.GetGeometry
                            If frmSetting.lvwBarrierEdges.ListItems.Count > 0 Then
                                Set objListItem = frmSetting.lvwBarrierEdges.ListItems.Add _
                                (, , CInt(frmSetting.lvwBarrierEdges.ListItems.Item(frmSetting.lvwBarrierEdges.ListItems.Count).Text) + 1)
                            Else
                                Set objListItem = frmSetting.lvwBarrierEdges.ListItems.Add(, , 1)
                            End If
                            objListItem.SubItems(1) = objgeoline.ID
                                                    
                    End Select
                
                Case 2:  '中心点分析
                    Select Case SuperMap1.selection.Dataset.Type
                        Case scdPoint:
                            Set objrc = SuperMap1.selection.ToRecordset(False)
                            objrc.MoveFirst
                            Set objgeopoint = objrc.GetGeometry
                            PointInfoToListview objgeopoint, frmSetting.lvwCenters
                    End Select
            End Select
        End If
    End If
    
    
    If frmPathAnalyst.Visible Then
        Select Case SuperMap1.selection.Dataset.Type
            Case scdPoint:
                Set objrc = SuperMap1.selection.ToRecordset(False)
                objrc.MoveFirst
                Set objgeopoint = objrc.GetGeometry
                PointInfoToListview objgeopoint, frmPathAnalyst.lvwPathPoints
        End Select
    End If
End Sub

Private Sub SuperWkspManager1_LDbClick(ByVal nFlag As SuperMapLib.seSelectedItemFlag, ByVal strSelected As String, ByVal strParent As String)
    If nFlag = scsDataset Then
        SuperMap1.Layers.AddDataset SuperWorkspace1.Datasources(strParent).Datasets(strSelected), True
        SuperMap1.Refresh
        SuperLegend1.Refresh
        If SuperMap1.Layers(1).Dataset.Type = scdNetwork Then
            menu_Setting.Enabled = True
        End If
    End If
End Sub