frmallocate.frm

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

VERSION 5.00
Begin VB.Form frmAllocate 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "资源分配"
   ClientHeight    =   5145
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6180
   Icon            =   "frmAllocate.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5145
   ScaleWidth      =   6180
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame Frame4 
      Caption         =   "分析结果存储"
      Height          =   2175
      Left            =   120
      TabIndex        =   14
      Top             =   2400
      Width           =   6015
      Begin VB.TextBox txtAllocateResultTableName 
         Height          =   285
         Left            =   2760
         TabIndex        =   22
         Text            =   "AllocateResult"
         Top             =   780
         Width           =   1935
      End
      Begin VB.TextBox txtArcDt 
         Height          =   285
         Left            =   2760
         TabIndex        =   20
         Top             =   1740
         Width           =   1935
      End
      Begin VB.TextBox txtNodeDt 
         Height          =   285
         Left            =   2760
         TabIndex        =   17
         Top             =   1260
         Width           =   1935
      End
      Begin VB.TextBox txtRouteResource 
         Height          =   285
         Left            =   2760
         TabIndex        =   16
         Text            =   "RouteResource"
         Top             =   300
         Width           =   1935
      End
      Begin VB.Label Label6 
         Caption         =   "中心点统计数据集"
         Height          =   255
         Left            =   720
         TabIndex        =   21
         Top             =   780
         Width           =   1455
      End
      Begin VB.Label Label5 
         Caption         =   "弧段统计数据集"
         Height          =   255
         Left            =   720
         TabIndex        =   19
         Top             =   1740
         Width           =   1575
      End
      Begin VB.Label Label4 
         Caption         =   "节点统计数据集"
         Height          =   255
         Left            =   720
         TabIndex        =   18
         Top             =   1260
         Width           =   1335
      End
      Begin VB.Label Label3 
         Caption         =   "路由显示数据集"
         Height          =   255
         Left            =   720
         TabIndex        =   15
         Top             =   300
         Width           =   1455
      End
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   375
      Left            =   5115
      TabIndex        =   13
      Top             =   4665
      Width           =   975
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "分析"
      Height          =   375
      Left            =   3795
      TabIndex        =   12
      Top             =   4665
      Width           =   975
   End
   Begin VB.Frame Frame3 
      Caption         =   "DemandField"
      Height          =   735
      Left            =   120
      TabIndex        =   7
      Top             =   1560
      Width           =   6015
      Begin VB.ComboBox cmbEdgeDemandField 
         Height          =   315
         Left            =   4320
         TabIndex        =   10
         Top             =   240
         Width           =   1575
      End
      Begin VB.ComboBox cmbNodeDemandField 
         Height          =   315
         Left            =   1320
         TabIndex        =   9
         Top             =   240
         Width           =   1575
      End
      Begin VB.Label Label2 
         Caption         =   "弧度需求字段"
         Height          =   255
         Left            =   3120
         TabIndex        =   11
         Top             =   240
         Width           =   1095
      End
      Begin VB.Label Label1 
         Caption         =   "节点需求字段"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   240
         Width           =   1215
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "分析设置"
      Height          =   615
      Left            =   120
      TabIndex        =   4
      Top             =   840
      Width           =   6015
      Begin VB.CheckBox chkConnected 
         Caption         =   "允许资源的跨越分配"
         Height          =   255
         Left            =   2880
         TabIndex        =   6
         Top             =   240
         Width           =   2055
      End
      Begin VB.CheckBox chkFromCenter 
         Caption         =   "从中心点开始分配"
         Height          =   255
         Left            =   360
         TabIndex        =   5
         Top             =   240
         Width           =   2055
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "资源分配模式"
      Height          =   615
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   6015
      Begin VB.OptionButton optAllocateNodesAndEdges 
         Caption         =   "节点和弧段需求"
         Height          =   255
         Left            =   3720
         TabIndex        =   3
         Top             =   240
         Width           =   1695
      End
      Begin VB.OptionButton optAllocateEdges 
         Caption         =   "弧段需求"
         Height          =   255
         Left            =   1920
         TabIndex        =   2
         Top             =   240
         Width           =   1695
      End
      Begin VB.OptionButton optAllocateNodes 
         Caption         =   "节点需求"
         Height          =   255
         Left            =   360
         TabIndex        =   1
         Top             =   240
         Width           =   1695
      End
   End
End
Attribute VB_Name = "frmAllocate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdExit_Click()
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Dim nAllocateMode As seAllocateType
    Dim bFromCenter As Boolean
    Dim bConnected  As Boolean
    Dim strRouteDatasetName As String '路由显示数据集,带几何对象
    Dim strAllocateResultTableName As String '中心点分配情况,属性表
    Dim strCenterNodesTableName As String '需求节点分配情况,属性表
    Dim strCenterEdgesTableName As String '需求边分配情况,属性表
    Dim bResult As Boolean
    Dim objerror As New soError
    Dim objResultDv As soDatasetVector
   
    frmMain.SuperAnalyst1.NetworkAnalyst.LocationAllocateSetting.EdgeDemandField = cmbEdgeDemandField.Text
    frmMain.SuperAnalyst1.NetworkAnalyst.LocationAllocateSetting.NodeDemandField = cmbNodeDemandField.Text
    
    If optAllocateEdges.Value = True Then
        nAllocateMode = scaAllocateEdges
        strCenterEdgesTableName = txtArcDt.Text
    End If
    
    If optAllocateNodes.Value = True Then
        nAllocateMode = scaAllocateNodes
        strCenterNodesTableName = txtNodeDt.Text
    End If
    
    If optAllocateNodesAndEdges.Value = True Then
        nAllocateMode = scaAllocateNodesAndEdges
        strCenterEdgesTableName = txtNodeDt.Text
        strCenterNodesTableName = txtArcDt.Text
    End If
    
    strRouteDatasetName = txtRouteResource.Text
    bFromCenter = IIf(chkFromCenter.Value = 1, True, False)
    bConnected = IIf(chkConnected.Value = 1, True, False)
    
    Set objResultDv = frmMain.SuperAnalyst1.NetworkAnalyst.Allocate(nAllocateMode, bFromCenter, bConnected, strRouteDatasetName, strAllocateResultTableName, strCenterNodesTableName, strCenterEdgesTableName)
    If objResultDv Is Nothing Then
        MsgBox "soNetworkAnalystEx.Allocate分析失败!"
        MsgBox objerror.LastErrorMsg
    End If
    
End Sub

Private Sub Form_Load()
    Dim objFieldInfos As soFieldInfos
    Dim objFieldInfosPoint As soFieldInfos
    Dim objDatasetVector As soDatasetVector
    Dim objDatasetVectorPoint As soDatasetVector
    Dim i As Integer
    
    Set objDatasetVector = frmMain.SuperMap1.Layers(1).Dataset
    Set objFieldInfos = objDatasetVector.GetFieldInfos
    Set objDatasetVectorPoint = objDatasetVector.SubDataset
    Set objFieldInfosPoint = objDatasetVectorPoint.GetFieldInfos
    
    For i = 1 To objFieldInfos.Count
        cmbEdgeDemandField.AddItem objFieldInfos(i).Name
    Next
    
    For i = 1 To objFieldInfosPoint.Count
        cmbNodeDemandField.AddItem objFieldInfosPoint(i).Name
    Next i
    
    Set objFieldInfos = Nothing
    Set objDatasetVector = Nothing
    Set objFieldInfosPoint = Nothing
    Set objDatasetVectorPoint = Nothing
End Sub