frmmain.frm

gps and supermap VB编程方法

VERSION 5.00
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Begin VB.Form frmMain 
   Caption         =   "GPS"
   ClientHeight    =   4875
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7830
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4875
   ScaleWidth      =   7830
   StartUpPosition =   2  'CenterScreen
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   2340
      Top             =   2160
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   4335
      Left            =   0
      TabIndex        =   8
      Top             =   540
      Width           =   7815
      _Version        =   327682
      _ExtentX        =   13785
      _ExtentY        =   7646
      _StockProps     =   160
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   3300
      Top             =   2430
   End
   Begin VB.Frame Frame3 
      Height          =   555
      Left            =   30
      TabIndex        =   0
      Top             =   -75
      Width           =   6690
      Begin VB.CommandButton btnStartTrcak 
         Caption         =   "GPS跟踪"
         Height          =   360
         Left            =   5685
         TabIndex        =   7
         Top             =   150
         Width           =   945
      End
      Begin VB.CommandButton btnRefresh 
         Caption         =   "刷新"
         Height          =   360
         Left            =   3810
         TabIndex        =   6
         Top             =   150
         Width           =   930
      End
      Begin VB.CommandButton btnviewEntire 
         Caption         =   "全幅"
         Height          =   360
         Left            =   4740
         TabIndex        =   5
         Top             =   150
         Width           =   945
      End
      Begin VB.CommandButton btnSelect 
         Caption         =   "选择"
         Height          =   360
         Left            =   60
         TabIndex        =   4
         Top             =   150
         Width           =   930
      End
      Begin VB.CommandButton btnPan 
         Caption         =   "漫游"
         Height          =   360
         Left            =   2880
         TabIndex        =   3
         Top             =   150
         Width           =   930
      End
      Begin VB.CommandButton btnZoomOut 
         Caption         =   "缩小"
         Height          =   360
         Left            =   1935
         TabIndex        =   2
         Top             =   150
         Width           =   945
      End
      Begin VB.CommandButton btnZoomIn 
         Caption         =   "放大"
         Height          =   360
         Left            =   990
         TabIndex        =   1
         Top             =   150
         Width           =   945
      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示范工程说明=======================================
'
'功能简介：示范SuperMap Objects中的跟踪功能：GPS跟踪，每两点之间有一定的时间停顿
'所用控件：SuperMap控件、SuperWorkspace控件
'所用数据：..\Data\world\world.sdb和world.sdd文件
'操作说明：
'         点击"GPS跟踪"按钮，即可开始随机跟踪。每两点之间的时间停顿在0.5秒；
'         点击"STOP跟踪"按钮，即可停止随机跟踪。
'
'===================================SuperMap Objects示范工程说明结束=====================================

Option Explicit

Public 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 btnPan_Click()
    SuperMap1.Action = scaPan
End Sub

Private Sub btnRefresh_Click()
    SuperMap1.Refresh
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 btnStartTrcak_Click()
    If btnStartTrcak.Caption = "GPS跟踪" Then         '开始跟踪
        btnStartTrcak.Caption = "停止跟踪"
        Timer1.Enabled = True
    Else                                              '停止跟踪
        btnStartTrcak.Caption = "GPS跟踪"
        Timer1.Enabled = False
    End If
End Sub

Private Sub Form_Load()
    SuperMap1.Connect SuperWorkspace1.Object
    
    Dim objDS As soDataSource
    Dim objDt As soDataset
    Dim strDsName As String
    Dim strDsAlias As String
    Dim i As Integer
    
    strDsName = App.Path & "\..\Data\world\world.sdb"
    strDsAlias = PathToName(strDsName)
    Set objDS = Me.SuperWorkspace1.OpenDataSource(strDsName, strDsAlias, sceSDBPlus, True)
    If objDS Is Nothing Then
        MsgBox "数据源打开失败！", vbInformation
    Else
        Set objDt = objDS.Datasets.Item("world")
        If Not objDt Is Nothing Then
            SuperMap1.Layers.AddDataset objDt, True
            SuperMap1.Refresh
        End If
    End If
    
    SuperMap1.Action = scaSelect
    
    '初始化随机数
    Randomize
    Rnd
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    SuperMap1.Width = Me.Width
    SuperMap1.Height = Me.Height - 850
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SuperMap1.Close
    SuperMap1.Disconnect
    SuperWorkspace1.Close
End Sub

Private Sub Timer1_Timer()
    Dim objdst As soDataset
    
    Set objdst = SuperMap1.Layers(1).Dataset
    If Not objdst Is Nothing Then
        Location CoordinateX(objdst, SuperMap1), CoordinateY(objdst, SuperMap1), SuperMap1
    End If
End Sub