frmsetting.frm

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

            Left            =   480
            TabIndex        =   12
            Top             =   285
            Width           =   1980
         End
      End
      Begin VB.Frame Frame2 
         Caption         =   "结点弧段标识字段设置"
         Height          =   1110
         Left            =   150
         TabIndex        =   6
         Top             =   1590
         Width           =   6075
         Begin VB.ComboBox cmbNodeIDField 
            Appearance      =   0  'Flat
            Height          =   315
            Left            =   3255
            Style           =   2  'Dropdown List
            TabIndex        =   8
            Top             =   285
            Width           =   2310
         End
         Begin VB.ComboBox cmbEdgeIDField 
            Appearance      =   0  'Flat
            Height          =   315
            Left            =   3240
            Style           =   2  'Dropdown List
            TabIndex        =   7
            Top             =   675
            Width           =   2310
         End
         Begin VB.Label Label4 
            Caption         =   "节点标识字段"
            Height          =   270
            Left            =   480
            TabIndex        =   10
            Top             =   285
            Width           =   1980
         End
         Begin VB.Label Label3 
            Caption         =   "弧段标识字段"
            Height          =   270
            Left            =   480
            TabIndex        =   9
            Top             =   675
            Width           =   1980
         End
      End
      Begin VB.Frame Frame1 
         Caption         =   "路径分析阻力字段设置"
         Height          =   1110
         Left            =   165
         TabIndex        =   1
         Top             =   405
         Width           =   6075
         Begin VB.ComboBox cmbTFWeightField 
            Appearance      =   0  'Flat
            Height          =   315
            Left            =   3240
            Style           =   2  'Dropdown List
            TabIndex        =   5
            Top             =   675
            Width           =   2310
         End
         Begin VB.ComboBox cmbFTWeightField 
            Appearance      =   0  'Flat
            Height          =   315
            Left            =   3240
            Style           =   2  'Dropdown List
            TabIndex        =   4
            Top             =   285
            Width           =   2310
         End
         Begin VB.Label Label2 
            Caption         =   "反向阻力字段"
            Height          =   270
            Left            =   480
            TabIndex        =   3
            Top             =   675
            Width           =   1980
         End
         Begin VB.Label Label1 
            Caption         =   "正向阻力字段"
            Height          =   270
            Left            =   480
            TabIndex        =   2
            Top             =   285
            Width           =   1980
         End
      End
   End
End
Attribute VB_Name = "frmSetting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public iAction As Integer  '标识现在要做什么操作,1为添加障碍，2为添加中心点


Private Sub FieldsToCombobox(objdataset As soDatasetVector, cmblist As ComboBox)  '把数据集的字段集合显示到combobox
    Dim i As Integer
    For i = 1 To objdataset.FieldCount
        cmblist.AddItem objdataset.GetFieldInfo(i).Name
    Next i
End Sub

Private Sub DatasetsToCombobox(objDatasource As soDataSource, cmblist As ComboBox)  '把矢量数据集集合加到combobox
    Dim i As Integer
    For i = 1 To objDatasource.Datasets.Count
        If objDatasource.Datasets(i).Vector Then
            cmblist.AddItem objDatasource.Datasets(i).Name
        End If
    Next i
End Sub

Private Sub Init() '窗体初始化
        
    Dim objNetworkAnalystEx As soNetworkAnalystEx
    Dim objNetworkSetting As soNetworkSetting
    Dim objdv As soDatasetVector
    Dim objSubDv As soDatasetVector
    Dim objLongArrary As soLongArray
    Dim i As Integer
    Dim objListItem As ListItem
    Dim objrc As soRecordset
    Dim objgeopoint As soGeoPoint
    
    Dim objds As soDataSource
    Set objdv = frmMain.SuperMap1.Layers(1).Dataset
    If objdv.Type = scdNetwork Then '如果是网络数据集，那么初始化开始
        
        Set objSubDv = objdv.SubDataset
        Set objNetworkAnalystEx = frmMain.SuperAnalyst1.NetworkAnalyst
        
        Set objNetworkSetting = objNetworkAnalystEx.NetworkSetting
        Set objNetworkSetting.NetworkDataset = objdv
        '网络分析参数初始化
        FieldsToCombobox objdv, cmbFTWeightField
        cmbFTWeightField.Text = "smlength"
        FieldsToCombobox objdv, cmbTFWeightField
        cmbTFWeightField.Text = "smlength"
        FieldsToCombobox objSubDv, cmbNodeIDField
        cmbNodeIDField.Text = "smid"
        FieldsToCombobox objdv, cmbEdgeIDField
        cmbEdgeIDField.Text = "smid"
        txtTolerance = objNetworkAnalystEx.Tolerance
        txtEdgeFilter = objNetworkSetting.EdgeFilter.Filter
        
        '连通性分析参数初始化
        
        '障碍参数初始化
        Set objLongArrary = objNetworkSetting.BarrierNodes
        If Not objLongArrary Is Nothing Then
            For i = 1 To objLongArrary.Count
                Set objListItem = lvwBarrierNodes.ListItems.Add(, , i)
                objListItem.SubItems(0) = objLongArrary.Item(i)
                Set objrc = objSubDv.Query("smid=" + objLongArrary.Item(i), True)
                If objrc.RecordCount > 0 Then
                    Set objgeopoint = objrc.GetGeometry
                    objListItem.SubItems(1) = objgeopoint.x
                    objListItem.SubItems(2) = objgeopoint.y
                    objrc.Close
                End If
            Next i
        End If
        
        
        Set objLongArrary = objNetworkSetting.BarrierEdges
        If Not objLongArrary Is Nothing Then
            For i = 1 To objLongArrary.Count
                Set objListItem = lvwBarrierNodes.ListItems.Add(, , i)
                objListItem.SubItems(0) = objLongArrary.Item(i)
                Set objrc = objSubDv.Query("smid=" + objLongArrary.Item(i), True)
                If objrc.RecordCount > 0 Then
                    Set objgeopoint = objrc.GetGeometry
                    objListItem.SubItems(1) = objgeopoint.x
                    objListItem.SubItems(2) = objgeopoint.y
                    objrc.Close
                End If
            Next i
        End If
        
        '中心点设置。
        
        FieldsToCombobox objSubDv, cmbResource
        FieldsToCombobox objSubDv, cmbMaxImpedence
        FieldsToCombobox objSubDv, cmbCenterCandidateType
        
        
        '转向表设置初始化
        
        
        
        
        
        
    End If
End Sub

Private Sub ApplySetting()   '应用更改
    
    Dim objNetworkAnalystEx As soNetworkAnalystEx
    Dim objNetworkSetting As soNetworkSetting
    Dim objQuerydef As soQueryDef
    Dim objLongArray As soLongArray
    Dim objLocationAllocate As soLocationAllocateSetting
    
    Dim objCenters As soCenters
    Dim objCenter As New soCenter
    Dim i As Integer
    Dim objdv As soDatasetVector
    Dim objSubDv As soDatasetVector
    Dim objrc As soRecordset
    
    Set objdv = frmMain.SuperMap1.Layers(1).Dataset
    If objdv.Type = scdNetwork Then
        Set objSubDv = objdv.SubDataset
        iAction = 0
        
        Set objNetworkAnalystEx = frmMain.SuperAnalyst1.NetworkAnalyst
        Set objNetworkSetting = objNetworkAnalystEx.NetworkSetting
        Set objLocationAllocate = frmMain.SuperAnalyst1.NetworkAnalyst.LocationAllocateSetting
        
        '网络分析参数设置
        objNetworkSetting.FTWeightField = cmbFTWeightField.Text
        objNetworkSetting.TFWeightField = cmbTFWeightField
        objNetworkSetting.NodeIDField = cmbNodeIDField
        objNetworkSetting.EdgeIDField = cmbEdgeIDField
        objNetworkAnalystEx.Tolerance = txtTolerance
        Set objQuerydef = objNetworkSetting.EdgeFilter
        objQuerydef.Filter = txtEdgeFilter
        Set objNetworkSetting.EdgeFilter = objQuerydef
        
        '连通性分析参数设置
        
        
        '网络障碍设置
        Set objLongArray = New soLongArray
        For i = 1 To lvwBarrierNodes.ListItems.Count
            objLongArray.Add lvwBarrierNodes.ListItems(i).SubItems(1)
        Next i
        Set objNetworkSetting.BarrierNodes = objLongArray
        
        objLongArray.RemoveAll
        For i = 1 To lvwBarrierEdges.ListItems.Count
            objLongArray.Add lvwBarrierEdges.ListItems(i).SubItems(1)
        Next i
        Set objNetworkSetting.BarrierEdges = objLongArray
        
        '中心点设置
        Set objCenters = objLocationAllocate.Centers
        objCenters.RemoveAll
        For i = 1 To lvwCenters.ListItems.Count
            objCenter.CenterID = lvwCenters.ListItems(i).SubItems(1)
            Set objrc = objSubDv.Query("smid=" + CStr(objCenter.CenterID), True)
            If cmbResource.Text <> "" Then objCenter.Resource = objrc.GetFieldValue(cmbResource.Text)
            If cmbMaxImpedence.Text <> "" Then objCenter.MaxImpedence = objrc.GetFieldValue(cmbMaxImpedence.Text)
            If cmbCenterCandidateType.Text <> "" Then objCenter.CenterCandidateType = objrc.GetFieldValue(cmbCenterCandidateType.Text)
            objCenters.Add objCenter
            
        Next i
        
        
        frmMain.menu_PathAnalyst.Enabled = True
        If Not objNetworkAnalystEx.LocationAllocateSetting.Centers Is Nothing Then
            If objNetworkAnalystEx.LocationAllocateSetting.Centers.Count > 0 Then
                frmMain.menu_AllocateAnalyst.Enabled = True
                frmMain.menu_LocationsAllocate.Enabled = True
            End If
        End If
        
        Set objLongArray = Nothing
    
    
    End If
    
End Sub

Private Sub Command12_Click()
    Me.Hide
End Sub

Private Sub btnAddBarrier_Click()
    iAction = 1
    frmMain.SuperMap1.Action = scaSelect
End Sub

Private Sub btnAddCenter_Click()
    iAction = 2
    frmMain.SuperMap1.Action = scaSelect
End Sub

Private Sub btnApply_Click()
    ApplySetting
End Sub

Private Sub btnCancel_Click()
    Me.Hide
End Sub

Private Sub btnOk_Click()
    ApplySetting
    Me.Hide
End Sub

Private Sub btnRemoveBarrier_Click()
    If (lvwBarrierNodes.SelectedItem Is Nothing) And (lvwBarrierEdges.SelectedItem Is Nothing) Then
        MsgBox "请选中一条记录"
    Else
        If Not lvwBarrierNodes.SelectedItem Is Nothing Then lvwBarrierNodes.ListItems.Remove lvwBarrierNodes.SelectedItem.Index
        If Not lvwBarrierEdges.SelectedItem Is Nothing Then lvwBarrierEdges.ListItems.Remove lvwBarrierEdges.SelectedItem.Index
        
    End If
End Sub

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

Private Sub Form_Load()
    Init
End Sub