frmprjinfo.frm

来自「都是基于VB所做的程序集合,值得大家作为实践的参考资料.」· FRM 代码 · 共 473 行 · 第 1/2 页

      TabIndex        =   2
      Top             =   600
      Width           =   1215
   End
   Begin VB.Label Label17 
      Caption         =   "类型（Type）"
      Height          =   255
      Left            =   3120
      TabIndex        =   1
      Top             =   960
      Width           =   1095
   End
End
Attribute VB_Name = "frmPCSProp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private nClickedItem As Integer

Public objPCS As soPJCoordSys
Private bFormLoaded As Boolean

Private Sub cmdCancel_Click()
    Set objPCS = Nothing

    Unload Me
End Sub

Private Sub cmdGCS_Click()
    Set frmGCSProp.objPCS = objPCS
    frmGCSProp.Show vbModal
End Sub

Private Sub cmdTranslate_Click()
    Dim objPrjTranslator As New soPJTranslator
    Dim strPcsSrcName, strPcsDesName As String
    Dim objDatasource As soDataSource
    Dim strDSName As String
    
    
    If (MsgBox("选择【确定】设定转换的目标坐标系，选【取消】放弃操作", vbOKCancel, "修改数据源坐标系") = vbOK) Then
    '用户决定转换坐标系
        If objPCS.ShowSettingDialog Then
        
            
            Set objDatasource = FrmMain.SuperWorkspace1.Datasources(1)
            strPcsDesName = objPCS.Name
            strPcsSrcName = objDatasource.PJCoordSys.Name
            

            If MsgBox("源投影：" & strPcsSrcName & Chr(13) & "目标投影:" & strPcsDesName & Chr(13) _
            & "选择【确定】转换坐标系，选【取消】放弃操作", vbOKCancel, "转换数据源坐标系") = vbOK Then
                
                Set objPrjTranslator.PJCoordSysDes = objPCS
            
                Set objPrjTranslator.PJCoordSysSrc = objDatasource.PJCoordSys
                
                objPrjTranslator.Create
                
                If objPrjTranslator.Convert(objDatasource) Then
                    MsgBox strPcsSrcName & "==>" & strPcsDesName & "  转换成功！"
                    Unload Me
                Else
                    MsgBox "转换失败！"
                End If
                Set objPCS = objDatasource.PJCoordSys
                InitPCS
                Set objPrjTranslator = Nothing
            End If
        End If
    End If
End Sub

Private Sub cmdOK_Click()
    Dim objDatasource As soDataSource
    Dim sString, strDSName As String
    Dim bResult  As Boolean
    Dim i As Integer
    
    If (MsgBox("选择【确定】为数据源设定新的坐标系，选【取消 放弃操作", vbOKCancel, "修改数据源坐标系") = vbOK) Then
    
        If objPCS.ShowSettingDialog Then
'            If Not (frmMain.TreeViewData.SelectedItem.Parent Is Nothing) Then
'
'                If frmMain.TreeViewData.SelectedItem.Parent.Index = 1 Then
'                    strDSName = frmMain.TreeViewData.SelectedItem.Text
'                    Set objDatasource = frmMain.SuperWorkspace.Datasources.Item(strDSName)
                    Set objDatasource = Form1.SuperWorkspace1.Datasources(1)
                    If Not (objDatasource Is Nothing) Then
                        Set objDatasource.PJCoordSys = objPCS
                    End If
'                End If
'            End If
        End If
    End If
        
End Sub

Private Sub Form_Load()
    Dim objDatasource As soDataSource
    Dim sString, strDSName As String
    Dim bResult  As Boolean
    Dim i As Integer
    Set objDatasource = FrmMain.SuperWorkspace1.Datasources(1)
    If Not (objDatasource Is Nothing) Then
       Set objPCS = objDatasource.PJCoordSys
       InitPCS
       bFormLoaded = True
       cmbTransMethod.Text = cmbTransMethod.List(1)
    Else
       MsgBox "数据源不存在！"
       Exit Sub
    End If
     
End Sub

Public Sub InitPCS()
    Dim i As Integer
    
    If objPCS Is Nothing Then
        MsgBox "投影坐标系为空！"
        Exit Sub
    End If
    
    txtName.Text = objPCS.Name
    '投影系类型
    For i = 0 To cmbPCSType.ListCount - 1
        If cmbPCSType.ItemData(i) = objPCS.Type Then
            cmbPCSType.Text = cmbPCSType.List(i)
            Exit For
        End If
    Next
    
    If (i = cmbPCSType.ListCount) Then
        'MsgBox "不存在的投影系！"
        cmbPCSType.Text = objPCS.Type
    End If
 
 '投影坐标单位
    For i = 0 To cmbUnit.ListCount - 1
        If cmbUnit.ItemData(i) = objPCS.CoordUnits Then
            cmbUnit.Text = cmbUnit.List(i)
            'cmbUnit.ListIndex = i
            Exit For
        End If
    Next
    If (i = cmbUnit.ListCount) Then
        'MsgBox "不存在的坐标单位！"
        cmbUnit.Text = objPCS.CoordUnits
    End If
  
  '投影距离单位
    For i = 0 To cmbDistUnit.ListCount - 1
        If cmbDistUnit.ItemData(i) = objPCS.DistUnits Then
            cmbDistUnit.Text = cmbDistUnit.List(i)
            Exit For
        End If
    Next
    If (i = cmbDistUnit.ListCount) Then
        'MsgBox "不存在的距离单位！"
        cmbDistUnit.Text = objPCS.DistUnits
    End If
    
    '投影类型
    For i = 0 To cmbPrjType.ListCount - 1
        If cmbPrjType.ItemData(i) = objPCS.Projection Then
            cmbPrjType.Text = cmbPrjType.List(i)
            Exit For
        End If
    Next
    If (i = cmbPrjType.ListCount) Then
        'MsgBox "不存在的投影类型！"
        cmbPrjType.Text = objPCS.Projection
    End If
    
    lvwPrjParam.ListItems.Clear
    Dim ListItem As ListItem
    Set ListItem = lvwPrjParam.ListItems.Add(1, , "东西平移")
    ListItem.SubItems(1) = objPCS.PJParams.FalseEasting
    
    Set ListItem = lvwPrjParam.ListItems.Add(2, , "南北平移")
    ListItem.SubItems(1) = objPCS.PJParams.FalseNorthing
    
    Set ListItem = lvwPrjParam.ListItems.Add(3, , "中央经线")
    ListItem.SubItems(1) = objPCS.PJParams.CentralMeridian
    
    Set ListItem = lvwPrjParam.ListItems.Add(4, , "第一点经线")
    ListItem.SubItems(1) = objPCS.PJParams.FirstPointLongitude
    
    Set ListItem = lvwPrjParam.ListItems.Add(5, , "第二点经线")
    ListItem.SubItems(1) = objPCS.PJParams.SecondPointLongitude
    
    Set ListItem = lvwPrjParam.ListItems.Add(6, , "中央纬线")
    ListItem.SubItems(1) = objPCS.PJParams.CentralParallel
    
    Set ListItem = lvwPrjParam.ListItems.Add(7, , "标准纬线1")
    ListItem.SubItems(1) = objPCS.PJParams.StandardParallel1
    
    Set ListItem = lvwPrjParam.ListItems.Add(8, , "标准纬线2")
    ListItem.SubItems(1) = objPCS.PJParams.StandardParallel2
    
    Set ListItem = lvwPrjParam.ListItems.Add(9, , "方位参数")
    ListItem.SubItems(1) = objPCS.PJParams.Azimuth
    
    Set ListItem = lvwPrjParam.ListItems.Add(10, , "X轴旋转")
    ListItem.SubItems(1) = objPCS.PJParams.RotateX
    
    Set ListItem = lvwPrjParam.ListItems.Add(11, , "Y轴旋转")
    ListItem.SubItems(1) = objPCS.PJParams.RotateY
    
    Set ListItem = lvwPrjParam.ListItems.Add(12, , "Z轴旋转")
    ListItem.SubItems(1) = objPCS.PJParams.RotateZ
    
    Set ListItem = lvwPrjParam.ListItems.Add(13, , "比例因素")
    ListItem.SubItems(1) = objPCS.PJParams.ScaleFactor
    
    Set ListItem = lvwPrjParam.ListItems.Add(14, , "X轴平移")
    ListItem.SubItems(1) = objPCS.PJParams.TranslateX
    
    Set ListItem = lvwPrjParam.ListItems.Add(15, , "Y轴平移")
    ListItem.SubItems(1) = objPCS.PJParams.TranslateY
    
    Set ListItem = lvwPrjParam.ListItems.Add(16, , "Z轴平移")
    ListItem.SubItems(1) = objPCS.PJParams.TranslateZ
    
    Set ListItem = lvwPrjParam.ListItems.Add(17, , "比例差")
    ListItem.SubItems(1) = objPCS.PJParams.ScaleDifference

    txtGCSName.Text = objPCS.GeoCoordSys.Name
    
    
End Sub