frmtrack.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 FrmTrack 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "跟踪示范"
   ClientHeight    =   6555
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9045
   Icon            =   "FrmTrack.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6555
   ScaleWidth      =   9045
   StartUpPosition =   2  'CenterScreen
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   5955
      Left            =   60
      TabIndex        =   6
      Top             =   540
      Width           =   8955
      _Version        =   327682
      _ExtentX        =   15796
      _ExtentY        =   10504
      _StockProps     =   160
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   2040
      Top             =   3480
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin VB.CommandButton btnViewEntire 
      Caption         =   "全幅显示"
      Height          =   375
      Left            =   75
      TabIndex        =   5
      Top             =   30
      Width           =   1485
   End
   Begin VB.CommandButton btnClose 
      Caption         =   "关闭"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   7500
      TabIndex        =   4
      Top             =   30
      Width           =   1485
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   5730
      Top             =   4500
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton btnBound 
      Caption         =   "视图定位"
      Height          =   375
      Left            =   6015
      TabIndex        =   3
      Top             =   30
      Width           =   1485
   End
   Begin VB.CommandButton btnTrackPolygon 
      Caption         =   "画面跟踪"
      Height          =   375
      Left            =   3045
      TabIndex        =   2
      Top             =   30
      Width           =   1485
   End
   Begin VB.CommandButton btnQuery 
      Caption         =   "查询跟踪"
      Height          =   375
      Left            =   4530
      TabIndex        =   1
      Top             =   30
      Width           =   1485
   End
   Begin VB.CommandButton btnTrackPolyline 
      Caption         =   "画线跟踪"
      Height          =   375
      Left            =   1560
      TabIndex        =   0
      Top             =   30
      Width           =   1485
   End
   Begin VB.Timer Timer1 
      Interval        =   500
      Left            =   5790
      Top             =   3735
   End
End
Attribute VB_Name = "FrmTrack"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'================================SuperMap Objects示范工程说明=================================
'
'功能简介：示范SuperMap Objects中的跟踪功能
'所用控件：SuperMap控件和SuperWorkspace控件
'所用数据：\..\Data\world下的World.sdb和World.sdd两个文件
'操作说明：
'         1、单击"画线跟踪"按钮，在地图窗口中画一条折线，会沿折线跟踪。
'         2、单击"画面跟踪"按钮，在地图窗口中画一个多边形，会沿多边形的边界跟踪。
'         3、单击"查询跟踪"按钮，在地图窗口中选择一个对象，如果是线对象，会沿对象跟踪；如果是面对象，
'                 会沿对象的边界跟踪；如果是点对象，会在点上画一个红点。
'         4、单击"视图定位"按钮，在地图窗口中移动鼠标，会出现一个红色矩形和一个红点，
'                单击鼠标左键，地图窗口将把红色矩形内的对象放大至全屏；单击右键结束"视图定位"。
'
'===============================SuperMap Objects示范工程说明结束===============================
'
Dim objPointsTracked As soPoints, nCurPoint As Long       '定义点实例的集合变量和点实例的计数器
Dim bTracking As Boolean                      '定义控制"选择跟踪"的变量
Dim objStyleTracking As New soStyle                  '定义一个实例的风格变量
Dim objGeoLineTracked As soGeoLine                            '定义线实例变量
Dim bViewBnd As Boolean                          '定义控制"视图定位"的变量
Dim objGeoPointViewCenter As New soGeoPoint                '定义视图中心点变量

Private Function PathToName(ByVal strPath As String) As String
'=====================================================
'自定义函数,将文件全路径名转化为文件名(无路径名,无扩展名)
'=====================================================
      Dim iLength As Integer      '字符串长度
      Dim i As Integer
      Dim strTemp As String
      Dim strTemp1 As String
      Dim iPosition As Integer
      
      iPosition = 999
      If InStr(strPath, ".") <> 0 Then
            strTemp = Left(strPath, Len(strPath) - 4)
      Else
            strTemp = strPath
      End If
      
      iLength = Len(strTemp)
      For i = Len(strPath) To 1 Step -1
               If Mid$(strTemp, i, 1) = "\" Then
                     iPosition = i
                     Exit For
               End If
      Next
       If iPosition = 999 Then
            PathToName = strTemp
       Else
            PathToName = Right(strTemp, iLength - iPosition)
       End If
End Function

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

Private Sub btnViewEntire_Click()
      SuperMap1.ViewEntire                  '全幅显示
End Sub

Private Sub btnTrackPolyline_Click()
      If bViewBnd Then
        bViewBnd = False
        SuperMap1.TrackingLayer.ClearEvents
        SuperMap1.TrackingLayer.Refresh
      End If
      SuperMap1.Action = scaTrackPolyline   '画线跟踪，先画一根线，在SuperMap1_Tracked()中实现跟踪
End Sub

Private Sub btnQuery_Click()
      '查询跟踪
      bTracking = True                    '开始查询跟踪
      bViewBnd = False                       '停止视图定位
      SuperMap1.TrackingLayer.ClearEvents   '清除所有实例
      SuperMap1.Refresh
      SuperMap1.Action = scaSelect          'SuperMap1的状态设为"选择"
End Sub

Private Sub btnTrackPolygon_Click()
      If bViewBnd Then
        bViewBnd = False
        SuperMap1.TrackingLayer.ClearEvents
        SuperMap1.TrackingLayer.Refresh
      End If
      SuperMap1.Action = scaTrackPolygon    '画面跟踪，先画一个面，在SuperMap1_Tracked()中实现跟踪
End Sub

Private Sub btnBound_Click()
      If Timer1.Enabled Then
            Timer1.Enabled = False
      End If
      
      bViewBnd = True
      SuperMap1.Action = scaNull
      SuperMap1.TrackingLayer.ClearEvents