frmmain.frm

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

      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.程序说明：示范如果通过定一个QueryDef来进行复杂查询；
'2.使用数据说明：打开Data目录下的World\World.sdb；
'3.操作说明：
'   (1)查询参数中设置为“矩形范围查询”，点击“复杂查询”按钮，程序将当前地图窗口
'      作为查询范围；
'   (2)查询参数中设置为“IDs查询”，点击“复杂查询”按钮，程序中将ID为2、3、5、8、13
'      的添加到QueryDef中进行查询；
'   (3)查询参数中设置为“空间位置关系”，在地图窗口中选择一个面对象，点击“复杂查询”
'      按钮，程序中查询点层中落入地图窗口中选择的面对象范围内的结果；
'   (4)查询参数中设置为“普通查询”，这种是对属性的查询，可以在查询条件中输入要查询
'      的内容，并设置是否要分组和排序，然后点击“复杂查询”按钮。
'=================================================================================
Option Explicit

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdPan_Click()
    SuperMap.Action = scaPan
End Sub

Private Sub cmdSelect_Click()
    SuperMap.Action = scaSelect
End Sub

Private Sub cmdViewEnt_Click()
    SuperMap.ViewEntire
End Sub

Private Sub cmdZoomFree_Click()
    SuperMap.Action = scaZoomFree
End Sub

Private Sub cmdZoomIn_Click()
    SuperMap.Action = scaZoomIn
End Sub

Private Sub cmdZoomOut_Click()
    SuperMap.Action = scaZoomOut
End Sub

Private Sub cmdQuery2_Click()
    Dim objQueryDef As New soQueryDef                       '定义空间数据查询对象
    Dim objLngAry As New soLongArray                        '定义ID数组
    Dim objDtv As soDatasetVector                           '定义需要查询得数据集
    Dim objDt As soDataset
    Dim objSel As soSelection                               '定义选择集
    Dim objGmtry As soGeometry                              '定义几何对象
    Dim objRect As soRect                                   '定义范围对象
    Dim objRst As soRecordset                               '定义记录集
    
    Set objDtv = SuperMap.Layers("Capital@World").Dataset   '获取数据集
    If Not objDtv Is Nothing Then
        If optRect.Value Then                               '进行范围查询
            objQueryDef.QueryType = scqBounds
            Set objRect = SuperMap.ViewBounds
            Set objQueryDef.Bounds = objRect                '设置查询范围
            objQueryDef.Fuzzy = IIf(ckFuzzy.Value = 1, True, False)
        ElseIf optIDs.Value Then                            '进行ID数组查询
            objQueryDef.QueryType = scqIDs
            objLngAry.Add 2
            objLngAry.Add 3
            objLngAry.Add 5
            objLngAry.Add 8
            objLngAry.Add 13
            Set objQueryDef.IDs = objLngAry                 '设置查询数组
        ElseIf optGmtry.Value Then                          '几何对象空间分析查询
            objQueryDef.QueryType = scqSpatialRelation
            Set objSel = SuperMap.selection
            Set objDt = objSel.Dataset
            If Not objDt Is Nothing Then
                If objSel.Count > 0 And objDt.Type = scdRegion Then
                    Set objRst = objSel.ToRecordset(True)
                    Set objGmtry = objRst.GetGeometry
                    Set objQueryDef.geometry = objGmtry     '获取所选择的面对象
                    objQueryDef.SpatialQueryMode = scsContaining
                Else
                    lblRst.Caption = ""
                    lblRst.Refresh
                    MsgBox "请先选择一个面对象", vbInformation, "信息提示"
                    GoTo erh
                End If
            Else
                lblRst.Caption = ""
                lblRst.Refresh
                MsgBox "请先选择一个面对象", vbInformation, "信息提示"
                GoTo erh
            End If
        ElseIf optGen.Value Then                            '普通查询
            objQueryDef.QueryType = scqGeneral
            objQueryDef.Filter = Trim(txtFlt.Text)
            objQueryDef.HasGeometry = False
            If ckOrder.Value = 1 Then objQueryDef.SortClause = "ORDER BY smid DESC"
            If ckGrp.Value = 1 Then
                objQueryDef.Fields.Add "smid"
                objQueryDef.GroupClause = "GROUP BY smid"
            End If
        End If
        objQueryDef.CursorLocation = sclUseServer
        objQueryDef.CursorType = sctOpenForwardOnly
        Set objRst = objDtv.Query2(objQueryDef)
        If Not objRst Is Nothing Then
            '将查询结果添加到选择集中
            SuperMap.selection.Dataset = objDtv
            SuperMap.selection.FromRecordset objRst
            SuperMap.Refresh
            
            '将查询结果显示在GridView中
            SuperGridView.Connect objRst
            SuperGridView.Update
            lblRst.Caption = "查询记录数:" & objRst.RecordCount
            lblRst.Refresh
        Else
            SuperGridView.Disconnect
            SuperGridView.Update
            lblRst.Caption = ""
            lblRst.Refresh
            MsgBox "获取查询结果失败", vbInformation, "信息提示"
        End If
    End If
    
erh:
    Set objQueryDef = Nothing
    Set objLngAry = Nothing
    Set objDtv = Nothing
    Set objSel = Nothing
    Set objGmtry = Nothing
    Set objRect = Nothing
    Set objRst = Nothing
End Sub

Private Sub Form_Load()
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim objLayer As soLayer
    
    SuperMap.Connect SuperWorkspace.Handle
    Set objDs = SuperWorkspace.OpenDataSource(App.Path & "\..\Data\World\World.sdb", "World", sceSDBPlus, False)
    If objDs Is Nothing Then Exit Sub
    
    Set objDt = objDs.Datasets("World")
    If objDt Is Nothing Then Exit Sub
    SuperMap.Layers.AddDataset objDt, True
    Set objDt = objDs.Datasets("Capital")
    If objDt Is Nothing Then Exit Sub
    Set objLayer = SuperMap.Layers.AddDataset(objDt, True)
    objLayer.Style.SymbolSize = 30
    objLayer.Selectable = False
    SuperMap.ViewEntire
    optRect_Click
    
    Set objDt = Nothing
    Set objDs = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SuperGridView.Disconnect
    SuperMap.Disconnect
    SuperMap.Close
    SuperWorkspace.Close
End Sub

Private Sub optGen_Click()
    If optGen.Value = True Then
        lblInfo.Caption = "" & vbCrLf & _
                "         普通属性查询，通过指定filter过滤条件来得到查询结果集。" & _
                          "请在上面的文本框中输入过滤条件（比如SMID<20）进行查询。"
        lblInfo.Refresh
        txtFlt.Text = "smid<20"
        txtFlt.Enabled = True
        txtFlt.BackColor = vbWhite
        Label2(1).Enabled = True
        ckFuzzy.Enabled = False
        ckGrp.Enabled = True
        ckOrder.Enabled = True
    End If
End Sub

Private Sub optGmtry_Click()
    If optGmtry.Value = True Then
        lblInfo.Caption = "" & vbCrLf & _
                "         空间位置关系查询模式，通过指定几何对象,查询获取结果集。" & _
                          "该范例以选择集中的一个面对象进行空间查询。"
        lblInfo.Refresh
        ckFuzzy.Enabled = False
        setTxtDisable
    End If
End Sub

Private Sub optIDs_Click()
    If optIDs.Value = True Then
        lblInfo.Caption = "" & vbCrLf & _
                "         IDs查询，通过指定ID数组来得到相关的记录集。" & _
                          "该范例以一些具体的整型数组为例进行查询。"
        lblInfo.Refresh
        ckFuzzy.Enabled = False
        setTxtDisable
    End If
End Sub

Private Sub optRect_Click()
    If optRect.Value = True Then
        lblInfo.Caption = "" & vbCrLf & _
                 "         Bounds查询，查询得到指定矩形范围内的记录集。" & _
                          "该范例以地图窗口显示范围为例进行查询。"
        lblInfo.Refresh
        ckFuzzy.Enabled = True
        setTxtDisable
    End If
End Sub

Private Sub setTxtDisable()
    txtFlt.Enabled = False
    txtFlt.Text = ""
    txtFlt.BackColor = &H8000000F
    Label2(1).Enabled = False
    ckGrp.Enabled = False
    ckOrder.Enabled = False
End Sub