frmmain.frm

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

      Top             =   30
      Width           =   960
   End
   Begin VB.CommandButton btnBrowsTools 
      Caption         =   "刷新"
      Height          =   435
      Index           =   8
      Left            =   7725
      TabIndex        =   8
      Top             =   30
      Width           =   960
   End
   Begin VB.CommandButton btnBrowsTools 
      Caption         =   "全图"
      Height          =   435
      Index           =   7
      Left            =   6765
      TabIndex        =   7
      Top             =   30
      Width           =   960
   End
   Begin VB.CommandButton btnBrowsTools 
      Caption         =   "自由缩放"
      Height          =   435
      Index           =   6
      Left            =   5805
      TabIndex        =   6
      Top             =   30
      Width           =   960
   End
   Begin VB.CommandButton btnBrowsTools 
      Caption         =   "缩小"
      Height          =   435
      Index           =   5
      Left            =   4845
      TabIndex        =   5
      Top             =   30
      Width           =   960
   End
   Begin VB.CommandButton btnBrowsTools 
      Caption         =   "放大"
      Height          =   435
      Index           =   4
      Left            =   3885
      TabIndex        =   4
      Top             =   30
      Width           =   960
   End
   Begin VB.CommandButton btnBrowsTools 
      Caption         =   "漫游"
      Height          =   435
      Index           =   3
      Left            =   2925
      TabIndex        =   3
      Top             =   30
      Width           =   960
   End
   Begin VB.CommandButton btnBrowsTools 
      Caption         =   "圆选"
      Height          =   435
      Index           =   2
      Left            =   1965
      TabIndex        =   2
      Top             =   30
      Width           =   960
   End
   Begin VB.CommandButton btnBrowsTools 
      Caption         =   "框选"
      Height          =   435
      Index           =   1
      Left            =   1005
      TabIndex        =   1
      Top             =   30
      Width           =   960
   End
   Begin VB.CommandButton btnBrowsTools 
      Caption         =   "点选"
      Height          =   435
      Index           =   0
      Left            =   45
      TabIndex        =   0
      Top             =   30
      Width           =   960
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'================================SuperMap Objects 示范工程说明=================================
'
'功能简介：示范对地图窗口的基本操作和状态设定。
'所用控件：SuperMap控件、SuperWorkspace控件
'所用数据：..\Data\World\目录下的world.sdb和world.sdb两个文件
'操作说明：
'        1、单击"点选"，可以在地图窗口中一次选择一个对象 ，按下Shift键，可以实现多选。按下Ctrl键，可以在多
'           层叠加的对象之间实现循环选择。
'        2、单击"放大"、"缩小"按钮，即可以点击放大缩小，也可以拉框放大缩小。
'        3、单击"自由缩放"按钮，按下鼠标左键，向上滑动是放大，向下滑动单击鼠标左键，地图窗口会自动滚屏。
'        4、选择"锁定窗口"，此时的地图只能缩小到全幅(但可以放大)，也不能移出地图窗口。
'        5、在最大比例、最小比例框中输入比例的分母，再放大、缩小地图，看看到什么时候地图不再变化。当最大
'           比例和最小比例为0或空时，则取消最大比例、最小比例。
'        6、选择"面对象按边选取"，就只能点取面对象的边界才能选中面对象，点取其内部不能选中。(可与7结合使用)
'        7、选择"隐藏线图层"和"隐藏面图层"，可以隐藏地图窗口中的所有该类图层。
'
'===============================SuperMap Objects示范工程说明结束===============================

Option Explicit

Private Sub btnBrowsTools_Click(Index As Integer)
    '设置SuperMap1的操作状态
    With SuperMap1
        Select Case Index
            Case 0
                .Action = scaSelect       '选择
            Case 1
                .Action = scaRectSelect   '矩形选择
            Case 2
                .Action = scaCircleSelect '圆形选择
            Case 3
                .Action = scaPan          '漫游
            Case 4
                .Action = scaZoomIn       '放大
            Case 5
                 .Action = scaZoomOut     '缩小
            Case 6
                .Action = scaZoomFree     '自由缩放
            Case 7
                .ViewEntire               '全幅显示
            Case 8
                .Refresh                  '刷新
        End Select
    End With
End Sub

Private Sub btnClose_Click()
    SuperMap1.Close
    SuperMap1.Disconnect
    SuperWorkspace1.Close
    End
End Sub

Private Sub btnSetScale_Click()
    '重新设置最大最小比例尺范围
    If (txtMaxScale.Text) = "" Then
        SuperMap1.MaxScale = 0
        MsgBox "你没有输入比例尺！", vbInformation
    ElseIf txtMaxScale.Text = "0" Then
        SuperMap1.MaxScale = 0
    Else
        If Val(txtMinScale) <= Val(txtMaxScale) Then
            MsgBox "比例尺设置错误，最大比例尺不能小于最小比例尺", vbCritical, "错误"
            Exit Sub
        End If
        SuperMap1.MaxScale = 1 / CDbl(txtMaxScale.Text)
    End If
    
    If (txtMinScale.Text) = "" Then
        SuperMap1.MinScale = 0
        MsgBox "你没有输入比例尺！", vbInformation
    ElseIf txtMinScale.Text = "0" Then
        SuperMap1.MinScale = 0
    Else
        If Val(txtMinScale) <= Val(txtMaxScale) Then
            MsgBox "比例尺设置错误，最大比例尺不能小于再最小比例尺", vbCritical, "错误"
            Exit Sub
        End If
        SuperMap1.MinScale = 1 / CDbl(txtMinScale.Text)
    End If
End Sub

Private Sub chkHideLineLayer_Click()
    '隐藏线图层
    Dim i As Integer
    
    For i = 1 To SuperMap1.Layers.Count
        If SuperMap1.Layers(i).Dataset.Type = scdLine Then
            SuperMap1.Layers(i).Visible = IIf(chkHideLineLayer.Value = vbChecked, False, True)
            SuperMap1.Refresh
        End If
    Next
End Sub

Private Sub chkHideRegionLayer_Click()
    '隐藏面图层
    Dim i As Integer
    
    For i = 1 To SuperMap1.Layers.Count
        If SuperMap1.Layers(i).Dataset.Type = scdRegion Then
            SuperMap1.Layers(i).Visible = IIf(chkHideRegionLayer.Value = vbChecked, False, True)
            SuperMap1.Refresh
        End If
    Next
End Sub

Private Sub chkLockViewWindow_Click()
    '锁定窗口
    Dim objRect As soRect
    Set objRect = SuperMap1.ViewBounds
    If (objRect Is Nothing) Then Exit Sub
    If (chkLockViewWindow.Value = vbChecked) Then
        SuperMap1.LockMapViewBounds = True
        Set SuperMap1.ViewBoundsForLocking = objRect
        SuperMap1.Action = scaPan
        MsgBox "请把地图移出地图窗口，看看会怎样！", vbInformation
    Else
        SuperMap1.LockMapViewBounds = False
    End If
End Sub

Private Sub chkMarginPan_Click()
    '自动滚屏
    If (chkMarginPan.Value = vbChecked) Then
        SuperMap1.MarginPanEnable = True
        SuperMap1.Action = scaSelect
        MsgBox "请把鼠标移到地图窗口边缘，看鼠标形状变化后，单击左键！", vbInformation
    Else
        SuperMap1.MarginPanEnable = False
    End If
End Sub

Private Sub chkSelectRegionBorder_Click()
    '面对象按边选取
    SuperMap1.HitTestBorderOnly = IIf(chkSelectRegionBorder.Value = vbChecked, True, False)
End Sub

Private Sub Form_Load()
    SuperMap1.Connect SuperWorkspace1.Handle
    
    SuperWorkspace1.OpenDataSource App.Path & "\..\data\world\world.sdb", "world", sceSDBPlus, True
    SuperMap1.Layers.AddDataset SuperWorkspace1.Datasources(1).Datasets("Grid"), True
    SuperMap1.Layers.AddDataset SuperWorkspace1.Datasources(1).Datasets("World"), True
    SuperMap1.ViewEntire
End Sub

Private Sub Form_Resize()
    SuperMap1.Width = Me.ScaleWidth - SuperMap1.Left - 20
    SuperMap1.Height = Me.ScaleHeight - SuperMap1.Top - 20
End Sub

Private Sub SuperMap1_AfterMapDraw(ByVal hdc As stdole.OLE_HANDLE)
    txtScale.Text = "1：" & (1 / SuperMap1.ViewScale)
End Sub

Private Sub txtMaxScale_LostFocus()
    txtMaxScale.Text = Val(Trim$(txtMaxScale.Text))
End Sub

Private Sub txtMinScale_LostFocus()
    txtMinScale.Text = Val(Trim$(txtMinScale.Text))
End Sub