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         =   "设置地图旋转效果"
   ClientHeight    =   6255
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   9990
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6255
   ScaleWidth      =   9990
   StartUpPosition =   2  'CenterScreen
   Begin SuperLegendLib.SuperLegend SuperLegend1 
      Height          =   2400
      Left            =   15
      TabIndex        =   1
      Top             =   3780
      Width           =   2055
      _Version        =   327682
      _ExtentX        =   3625
      _ExtentY        =   4233
      _StockProps     =   132
      Appearance      =   1
   End
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   5685
      Left            =   2145
      TabIndex        =   0
      Top             =   525
      Width           =   7770
      _Version        =   327682
      _ExtentX        =   13705
      _ExtentY        =   10028
      _StockProps     =   160
      Appearance      =   1
   End
   Begin VB.CommandButton btnRotateMap 
      Caption         =   "旋转地图"
      Height          =   435
      Left            =   8850
      TabIndex        =   11
      Top             =   15
      Width           =   990
   End
   Begin VB.CheckBox chkRotateText 
      Caption         =   "旋转文字"
      Height          =   195
      Left            =   7755
      TabIndex        =   10
      Top             =   135
      Width           =   1155
   End
   Begin VB.CheckBox chkRotateSymbol 
      Caption         =   "旋转符号"
      Height          =   195
      Left            =   6660
      TabIndex        =   9
      Top             =   135
      Width           =   1155
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   3345
      Top             =   3315
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin MSComDlg.CommonDialog cmdOpen 
      Left            =   4365
      Top             =   4410
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton btnViewEntire 
      Caption         =   "全幅"
      Height          =   435
      Left            =   5550
      TabIndex        =   8
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnPan 
      Caption         =   "平移"
      Height          =   435
      Left            =   4560
      TabIndex        =   7
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnZoomout 
      Caption         =   "缩小"
      Height          =   435
      Left            =   3570
      TabIndex        =   6
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnZoomin 
      Caption         =   "放大"
      Height          =   435
      Left            =   2580
      TabIndex        =   5
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton btnSelect 
      Caption         =   "选择"
      Height          =   435
      Left            =   1590
      TabIndex        =   4
      Top             =   15
      Width           =   990
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开数据源"
      Height          =   435
      Left            =   15
      TabIndex        =   3
      Top             =   15
      Width           =   1575
   End
   Begin SuperWkspManagerLib.SuperWkspManager SuperWkspManager1 
      Height          =   3255
      Left            =   15
      TabIndex        =   2
      Top             =   495
      Width           =   2055
      _Version        =   327682
      _ExtentX        =   3625
      _ExtentY        =   5741
      _StockProps     =   0
   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.程序说明：旋转地图时可以设置是否旋转点状符号和文字，这里示范如何使用这两个选项；
'2.数据说明：打开Data\MapRotation目录中的TestEdit.sdb数据源；
'3.使用说明：
'   (1)点击“打开数据源”，打开Data\MapRotation目录中的“TestEdit.sdb”；
'   (2)通过在数据集列表中双击数据集将该数据源中的三个数据集都添加到地图窗口中；
'   (3)在图例窗口中设置点图层的风格为能看得出方向的符号，以便测试的时候效果明显；
'   (4)根据测试需要，设置是否选择符号和是否旋转文本，然后点击“旋转地图”，输入旋转角
'      度，点击“确定”后观察地图的效果。
'======================================================================================
Option Explicit

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

Private Sub btnRotateMap_Click()
    Dim strAngle As String
    strAngle = InputBox("", "请输入一个旋转角度")
    If IsNumeric(strAngle) = False Then
        MsgBox "请输入一个数字"
    Else
        SuperMap1.RotationOptions.Angle = CDbl(strAngle)
        SuperMap1.RotationOptions.RotateSymbol = chkRotateSymbol.Value
        SuperMap1.RotationOptions.RotateText = chkRotateText.Value
        SuperMap1.Refresh
    End If
End Sub

Private Sub btnSelect_Click()
    SuperMap1.Action = scaSelect
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
        .InitDir = App.Path & "\..\Data\MapRotation"
        .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 "打开数据源失败"
        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 SuperLegend1_Modified()
    SuperMap1.Refresh
End Sub

Private Sub SuperWkspManager1_LDbClick(ByVal nFlag As SuperMapLib.seSelectedItemFlag, ByVal strSelected As String, ByVal strParent As String)
    If nFlag = scsDataset Then
        SuperMap1.Layers.AddDataset SuperWorkspace1.Datasources(strParent).Datasets(strSelected), True
        SuperMap1.Refresh
        SuperLegend1.Refresh
    End If
End Sub