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"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "frmMain"
   ClientHeight    =   6705
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   10695
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6705
   ScaleWidth      =   10695
   StartUpPosition =   2  'CenterScreen
   Begin SuperLegendLib.SuperLegend SuperLegend1 
      Height          =   2895
      Left            =   120
      TabIndex        =   1
      Top             =   3720
      Width           =   2055
      _Version        =   327682
      _ExtentX        =   3625
      _ExtentY        =   5106
      _StockProps     =   132
      Appearance      =   1
   End
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   6135
      Left            =   2280
      TabIndex        =   0
      Top             =   480
      Width           =   8415
      _Version        =   327682
      _ExtentX        =   14843
      _ExtentY        =   10821
      _StockProps     =   160
      BorderStyle     =   1
   End
   Begin VB.CommandButton btnSetEditHandle 
      Caption         =   "设置编辑句柄"
      Height          =   375
      Left            =   7200
      TabIndex        =   9
      Top             =   15
      Width           =   1335
   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          =   375
      Left            =   6090
      TabIndex        =   8
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnPan 
      Caption         =   "平移"
      Height          =   375
      Left            =   5010
      TabIndex        =   7
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnZoomout 
      Caption         =   "缩小"
      Height          =   375
      Left            =   3945
      TabIndex        =   6
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnZoomin 
      Caption         =   "放大"
      Height          =   375
      Left            =   2895
      TabIndex        =   5
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnSelect 
      Caption         =   "选择"
      Height          =   375
      Left            =   1830
      TabIndex        =   4
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开数据源"
      Height          =   375
      Left            =   180
      TabIndex        =   3
      Top             =   15
      Width           =   1575
   End
   Begin SuperWkspManagerLib.SuperWkspManager SuperWkspManager1 
      Height          =   3255
      Left            =   120
      TabIndex        =   2
      Top             =   480
      Width           =   2055
      _Version        =   327682
      _ExtentX        =   3625
      _ExtentY        =   5741
      _StockProps     =   0
   End
   Begin VB.Menu menu_SetEditHandle 
      Caption         =   ""
      Visible         =   0   'False
      Begin VB.Menu menu_BottomCenterEnabled 
         Caption         =   "下中点手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_BottomLeftEnabled 
         Caption         =   "左下角手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_BottomRightEnabled 
         Caption         =   "右下角手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_LeftCenterEnabled 
         Caption         =   "左中点手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_RightCenterEnabled 
         Caption         =   "右中点手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_TopCenterEnabled 
         Caption         =   "上中点手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_TopLeftEnabled 
         Caption         =   "左上角手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_TopRightEnabled 
         Caption         =   "右上角手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_VertexEnabled 
         Caption         =   "顶点编辑手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_RotateBaseEnabled 
         Caption         =   "旋转基点"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_RotationEnabled 
         Caption         =   "旋转手柄"
         Checked         =   -1  'True
      End
      Begin VB.Menu menu_MoveEnabled 
         Caption         =   "对象移动"
         Checked         =   -1  'True
      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、程序说明：示范如何设置11个编辑手柄的可用状态；
'2、使用数据说明：使用打开文件对话框打开一个SDB+引擎的数据源；
'3、操作说明：
'   (1)点击“打开数据源”按钮，选择一个SDB+引擎的数据源；
'   (2)在数据集列表中任意双击一个数据集，将其在地图窗口中打开；
'   (3)在图例中选择图层设置其“可编辑”；
'   (4)在地图窗口中选择一个对象，然后点击“设置编辑句柄”，在弹出菜单中选择任何一个
'      手柄菜单，设置其可用状态，设置后请注意观察地图窗口上手柄的状态变化。
'=====================================================================================

Option Explicit

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

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

Private Sub btnSetEditHandle_Click()
    PopupMenu menu_SetEditHandle, , btnSetEditHandle.Left, btnSetEditHandle.Top + btnSetEditHandle.Height
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
        .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 "打开数据源失败", vbInformation
        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
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
    SuperWorkspace1.Close
End Sub

Private Sub menu_BottomCenterEnabled_Click()
    menu_BottomCenterEnabled.Checked = Not menu_BottomCenterEnabled.Checked
    SuperMap1.EditHandleOptions.BottomCenterEnabled = menu_BottomCenterEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_BottomLeftEnabled_Click()
    menu_BottomLeftEnabled.Checked = Not menu_BottomLeftEnabled.Checked
    SuperMap1.EditHandleOptions.BottomLeftEnabled = menu_BottomLeftEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_BottomRightEnabled_Click()
    menu_BottomRightEnabled.Checked = Not menu_BottomRightEnabled.Checked
    SuperMap1.EditHandleOptions.BottomRightEnabled = menu_BottomRightEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_LeftCenterEnabled_Click()
    menu_LeftCenterEnabled.Checked = Not menu_LeftCenterEnabled.Checked
    SuperMap1.EditHandleOptions.LeftCenterEnabled = menu_LeftCenterEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_MoveEnabled_Click()
    menu_MoveEnabled.Checked = Not menu_MoveEnabled.Checked
    SuperMap1.EditHandleOptions.MoveEnabled = menu_MoveEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_RightCenterEnabled_Click()
    menu_RightCenterEnabled.Checked = Not menu_RightCenterEnabled.Checked
    SuperMap1.EditHandleOptions.RightCenterEnabled = menu_RightCenterEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_RotateBaseEnabled_Click()
    menu_RotateBaseEnabled.Checked = Not menu_RotateBaseEnabled.Checked
    SuperMap1.EditHandleOptions.RotateBaseEnabled = menu_RotateBaseEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_RotationEnabled_Click()
    menu_RotationEnabled.Checked = Not menu_RotationEnabled.Checked
    SuperMap1.EditHandleOptions.RotationEnabled = menu_RotationEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_TopCenterEnabled_Click()
    menu_TopCenterEnabled.Checked = Not menu_TopCenterEnabled.Checked
    SuperMap1.EditHandleOptions.TopCenterEnabled = menu_TopCenterEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_TopLeftEnabled_Click()
    menu_TopLeftEnabled.Checked = Not menu_TopLeftEnabled.Checked
    SuperMap1.EditHandleOptions.TopLeftEnabled = menu_TopLeftEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_TopRightEnabled_Click()
    menu_TopRightEnabled.Checked = Not menu_TopRightEnabled.Checked
    SuperMap1.EditHandleOptions.TopRightEnabled = menu_TopRightEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub menu_VertexEnabled_Click()
    menu_VertexEnabled.Checked = Not menu_VertexEnabled.Checked
    SuperMap1.EditHandleOptions.VertexEnabled = menu_VertexEnabled.Checked
    SuperMap1.Refresh
End Sub

Private Sub SuperLegend1_Modified()
    SuperMap1.Refresh
End Sub

Private Sub SuperWkspManager1_LDbClick(ByVal nFlag As SuperMapLib.seSelectedItemFlag, ByVal strSelected As String, ByVal strParent As String)
    Dim objDs As soDataSource
    Dim objDt As soDataset
        
    If nFlag = scsDataset Then
        Set objDs = SuperWorkspace1.Datasources.Item(strParent)
        If objDs Is Nothing Then Exit Sub
        Set objDt = objDs.Datasets.Item(strSelected)
        If objDt Is Nothing Then Exit Sub
        
        SuperMap1.Layers.AddDataset objDt, True
        SuperMap1.Refresh
        SuperLegend1.Refresh
    End If
End Sub