VERSION 5.00
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.0#0"; "SuperMap.ocx"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "經緯度坐標系下的面積距離量算"
   ClientHeight    =   6480
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   8805
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6480
   ScaleWidth      =   8805
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command8 
      Caption         =   "量算面積"
      Height          =   540
      Left            =   7695
      TabIndex        =   7
      Top             =   30
      Width           =   1095
   End
   Begin VB.CommandButton Command7 
      Caption         =   "量算距離"
      Height          =   540
      Left            =   6600
      TabIndex        =   6
      Top             =   30
      Width           =   1095
   End
   Begin VB.CommandButton Command6 
      Caption         =   "全幅"
      Height          =   540
      Left            =   5505
      TabIndex        =   5
      Top             =   30
      Width           =   1095
   End
   Begin VB.CommandButton Command5 
      Caption         =   "漫游"
      Height          =   540
      Left            =   4410
      TabIndex        =   4
      Top             =   30
      Width           =   1095
   End
   Begin VB.CommandButton Command4 
      Caption         =   "自由縮放"
      Height          =   540
      Left            =   3315
      TabIndex        =   3
      Top             =   30
      Width           =   1095
   End
   Begin VB.CommandButton Command3 
      Caption         =   "縮小"
      Height          =   540
      Left            =   2220
      TabIndex        =   2
      Top             =   30
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "放大"
      Height          =   540
      Left            =   1125
      TabIndex        =   1
      Top             =   30
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "選擇"
      Height          =   540
      Left            =   30
      TabIndex        =   0
      Top             =   30
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Height          =   5970
      Left            =   45
      TabIndex        =   8
      Top             =   495
      Width           =   8760
      Begin SuperMapLib.SuperMap SuperMap1 
         Height          =   4980
         Left            =   30
         TabIndex        =   9
         Top             =   120
         Width           =   8670
         _Version        =   327680
         _ExtentX        =   15293
         _ExtentY        =   8784
         _StockProps     =   160
         Appearance      =   1
      End
      Begin VB.Label lblRsult 
         Appearance      =   0  'Flat
         ForeColor       =   &H80000008&
         Height          =   750
         Left            =   5865
         TabIndex        =   12
         Top             =   5145
         Width           =   2850
      End
      Begin VB.Label lblTY 
         BorderStyle     =   1  'Fixed Single
         Height          =   765
         Left            =   2820
         TabIndex        =   11
         Top             =   5145
         Width           =   3000
      End
      Begin VB.Label lblJWD 
         BorderStyle     =   1  'Fixed Single
         Height          =   765
         Left            =   45
         TabIndex        =   10
         Top             =   5145
         Width           =   2760
      End
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   5430
      Top             =   1845
      _Version        =   327680
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim objpoint As New soPoint
Dim objPCS As New soPJCoordSys
Dim objGCS As New soPJGeoCoordSys
Dim objParams As New soPJParams
    
Private Sub Command7_Click()
    SuperMap1.Action = scaTrackPolyline
End Sub

Private Sub Command8_Click()
    SuperMap1.Action = scaTrackPolygon
End Sub

Private Sub Form_Load()
    Dim objDs As soDataSource
    Dim objDt As soDataset
    SuperMap1.Connect SuperWorkspace1.Handle
    Set objDs = SuperWorkspace1.OpenDataSource(App.Path & "\test.sdb", "test", sceSDBPlus, False)
    Set objDt = objDs.Datasets(1)
    SuperMap1.Layers.AddDataset objDt, True
    SuperMap1.ViewEntire
    SetPjCoord
    Set objDt = Nothing
    Set objDs = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objParams = Nothing
    Set objGCS = Nothing
    Set objPCS = Nothing
    Set objpoint = Nothing
    SuperMap1.Close
    SuperMap1.Disconnect
    SuperWorkspace1.Close
End Sub

Private Sub SuperMap1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim dx As Double
    Dim dy As Double
    If SuperMap1.Layers.Count = 0 Then Exit Sub
    dx = SuperMap1.PixelToMapX(ScaleX(x, vbTwips, vbPixels))
    dy = SuperMap1.PixelToMapY(ScaleY(y, vbTwips, vbPixels))
    lblJWD.Caption = "當前經緯坐標為:" & vbCrLf & "x=" & dx & "度" & vbCrLf & "y=" & dy & "度"
    ChangeJWD2TY dx, dy
End Sub

Private Sub SetPjCoord()
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim objRect As soRect
    Set objDs = SuperWorkspace1.Datasources(1)
    Set objDt = objDs.Datasets(1)
    Set objRect = objDt.Bounds
    
    objGCS.Type = scGCS_BEIJING_1954 '地理坐標系的類型
    '投影參數
    objParams.CentralMeridian = objRect.CenterPoint.x     '中央經線
    objParams.FalseEasting = 500000
        
    '設置投影系的屬性
    objPCS.Type = scPCS_USER_DEFINED    '投影系的類型
    objPCS.CoordUnits = scuMeter        '投影系的坐標單位
    objPCS.Projection = scPRJ_GAUSS_KRUGER   '投影方式
    Set objPCS.PJParams = objParams     '投影參數
    Set objPCS.GeoCoordSys = objGCS     '投影系所依賴的地理坐標系
    Set objpoint = Nothing
    Set objDs = Nothing
    Set objDt = Nothing
    Set objRect = Nothing
End Sub

Private Sub ChangeJWD2TY(dx As Double, dy As Double)
    objpoint.x = dx
    objpoint.y = dy
    objPCS.Forward objpoint
    dx = objpoint.x
    dy = objpoint.y
    lblTY.Caption = "當前投影坐標為:" & vbCrLf & "x=" & dx & "米" & vbCrLf & "y=" & dy & "米"
End Sub


Private Sub ChangeGeometry(objGm As soGeometry)
    Dim objDs As soDataSource
    Dim objPCSS As soPJCoordSys
    Dim objPjTranse As New soPJTranslator
    Dim objGr As soGeoRegion
    Dim objGl As soGeoLine
    Dim dZYJX As Double
    Dim dTmp As Double
    
    Set objDs = SuperWorkspace1.Datasources(1)
    Set objPCSS = objDs.PJCoordSys
    
    objPjTranse.Create
    Set objPjTranse.PJCoordSysSrc = objPCSS
    Set objPjTranse.PJCoordSysDes = objPCS
    If objGm.Type = scgRegion Then
        Set objGr = objGm
        dTmp = Format(objGr.Area, "#.####")
        objPjTranse.Convert objGr
        lblRsult.Caption = "面積為：" & vbCrLf & "轉換前>" & dTmp & "平方米" & vbCrLf & "轉換后>" & Format(objGr.Area, "#.####") & "平方米"
    ElseIf objGm.Type = scgLine Then
        Set objGl = objGm
        dTmp = Format(objGl.Length, "#.####")
        objPjTranse.Convert objGl
        lblRsult.Caption = "長度為：" & vbCrLf & "轉換前>" & dTmp & "米" & vbCrLf & "轉換后>" & Format(objGl.Length, "#.####") & "米"
    End If
    lblRsult.Refresh
    
    Set objGl = Nothing
    Set objGr = Nothing
    Set objDs = Nothing
    Set objPCSS = Nothing
    Set objPjTranse = Nothing
End Sub

Private Sub SuperMap1_Tracked()
    Dim objGm As soGeometry
    Set objGm = SuperMap1.TrackedGeometry
    ChangeGeometry objGm
    Set objGm = Nothing
End Sub