style.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Begin VB.Form FrmStyle 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "点线面注记和地图窗口背景的风格设置"
   ClientHeight    =   6765
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11040
   Icon            =   "Style.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6765
   ScaleWidth      =   11040
   StartUpPosition =   2  'CenterScreen
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   5280
      Top             =   3135
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   6255
      Left            =   75
      TabIndex        =   11
      Top             =   450
      Width           =   10890
      _Version        =   327682
      _ExtentX        =   19209
      _ExtentY        =   11033
      _StockProps     =   160
      BorderStyle     =   1
   End
   Begin VB.CommandButton btnSelectionStyle 
      Caption         =   "设置选中风格"
      Height          =   360
      Left            =   6000
      TabIndex        =   10
      Top             =   60
      Width           =   1245
   End
   Begin VB.CommandButton btnSelect 
      Caption         =   "选择"
      Height          =   360
      Left            =   7455
      TabIndex        =   9
      Top             =   45
      Width           =   705
   End
   Begin VB.CommandButton btnSetTextStyle 
      Caption         =   "设置文本风格"
      Height          =   360
      Left            =   3495
      TabIndex        =   8
      Top             =   45
      Width           =   1245
   End
   Begin VB.CommandButton btnSetPointStly 
      Caption         =   "设置点风格"
      Height          =   360
      Left            =   30
      TabIndex        =   7
      Top             =   45
      Width           =   1245
   End
   Begin VB.CommandButton btnViewEntire 
      Caption         =   "全幅"
      Height          =   360
      Left            =   10275
      TabIndex        =   6
      Top             =   45
      Width           =   705
   End
   Begin VB.CommandButton btnPan 
      Caption         =   "平移"
      Height          =   360
      Left            =   9570
      TabIndex        =   5
      Top             =   45
      Width           =   705
   End
   Begin VB.CommandButton btnZoomOut 
      Caption         =   "缩小"
      Height          =   360
      Left            =   8865
      TabIndex        =   4
      Top             =   45
      Width           =   705
   End
   Begin VB.CommandButton btnZoomIn 
      Caption         =   "放大"
      Height          =   360
      Left            =   8160
      TabIndex        =   3
      Top             =   45
      Width           =   705
   End
   Begin VB.CommandButton btnSetLineStyle 
      Caption         =   "设置线风格"
      Height          =   360
      Left            =   1275
      TabIndex        =   2
      Top             =   45
      Width           =   1110
   End
   Begin VB.CommandButton btnSetBackStyle 
      Caption         =   "设置背景风格"
      Height          =   360
      Left            =   4740
      TabIndex        =   1
      Top             =   45
      Width           =   1245
   End
   Begin MSComDlg.CommonDialog cdlOpenFile 
      Left            =   1830
      Top             =   3840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton btnSetRegionStyle 
      Caption         =   "设置面风格"
      Height          =   360
      Left            =   2385
      TabIndex        =   0
      Top             =   45
      Width           =   1110
   End
   Begin VB.Menu mnuPopup 
      Caption         =   ""
      Visible         =   0   'False
      Begin VB.Menu mnuAllText 
         Caption         =   "全部文本"
      End
      Begin VB.Menu mnuSelectedText 
         Caption         =   "所选文本"
      End
      Begin VB.Menu mnuCongenerText 
         Caption         =   "同类文本"
      End
   End
End
Attribute VB_Name = "FrmStyle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'================================SuperMap Objects示范工程说明=================================
'
'功能简介：
'        1、示范在SuperMap Objects中如何修改点、线、面和文本(注记图)层风格(数据集的显示风格)
'        2、示范SuperMap Objects中种类繁多的面填充模式(其中的独特的材质填充)和丰富的线型
'所用控件：SuperMap Objects的SuperMap和SuperWorkspace两个控件
'所用数据：上一级目录\..\Data\World\下的World.sdb和World.sdd两个文件
'操作说明：
'        1、使用"选择"、"放大"、"缩小"、"平移"和"全幅"按钮，可以对地图进行基本操作
'        2、使用"设置符号风格"、"设置线风格"、"设置面风格"按钮可以设置窗口中相应图层的风格
'        3、使用"设置背景风格"按钮可以设置地图窗口背景的风格
'        4、单击"设置文本风格"按钮，会弹出一个菜单，其上有三个菜单项："全部文本"、"所选文本"、"同类文本"
'           "全部文本"：修改文本图层中全部文本对象的风格；
'           "所选文本"：只修改所选文本对象的风格；
'           "同类文本"：只修改同类文本对象的风格；这里的同类文本对象是指字体、高度、颜色相同的文本对象
'        5、使用“设置选中风格”按钮可以设置地图图层的选中风格。
'===============================SuperMap Objects 示范工程说明结束===============================

Option Explicit
Dim objError As New soError

Private Sub btnPan_Click()              '平移
      SuperMap1.Action = scaPan
End Sub

Private Sub btnSelect_Click()           '选择
      SuperMap1.Action = scaSelect
End Sub

Private Sub btnSelectionStyle_Click()
      Dim objStyle As soStyle
      
      Set objStyle = SuperMap1.selection.Style
      If (objStyle Is Nothing) Then
            Exit Sub
      Else
            If SuperMap1.ShowStylePicker(objStyle, 2) Then
                  Set SuperMap1.selection.Style = objStyle
            End If
            SuperMap1.Action = scaSelect
      End If
      
      Set objStyle = Nothing
End Sub

Private Sub btnSetBackStyle_Click()     '设置背景风格
      SuperMap1.ShowStylePicker SuperMap1.BackStyle, 2
      SuperMap1.Refresh
End Sub

Private Sub btnSetPointStly_Click()     '设置点图层的风格
    Dim objLayer As soLayer
    
    Set objLayer = SuperMap1.Layers.Item("capital@World")
    If Not objLayer Is Nothing Then
        SuperMap1.ShowStylePicker objLayer.Style, 0
        SuperMap1.Refresh
    Else
        MsgBox "找不到capical图层"
    End If
End Sub

Private Sub btnSetRegionStyle_Click()   '设置面图层的风格
    Dim objLayer As soLayer
    
    Set objLayer = SuperMap1.Layers("World@World")
    If Not objLayer Is Nothing Then
        SuperMap1.ShowStylePicker objLayer.Style, 2
        SuperMap1.Refresh
    Else
        MsgBox "找不到world图层"
    End If
End Sub

Private Sub btnSetLineStyle_Click()     '设置线图层的风格
    Dim objLayer As soLayer
    
    Set objLayer = SuperMap1.Layers("Grid@World")
    If Not objLayer Is Nothing Then
        SuperMap1.ShowStylePicker objLayer.Style, 1
        SuperMap1.Refresh
    Else
        MsgBox "找不到grid图层"
    End If
End Sub

Private Sub btnSetTextStyle_Click()
      PopupMenu mnuPopup, , btnSetTextStyle.Left, btnSetTextStyle.Top + btnSetTextStyle.Height - 10
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 Form_Load()
      Dim objDS As soDataSource
      Dim strAlias As String            '数据源别名
      Dim nEngineType As seEngineType   '数据引擎类型
      Dim strDataSourceName As String   '数据源绝对路径名
      Dim objDataset As soDataset

       '建立SuperMap控件与SuperWorkspace之间的联系