📄 frmdefinecoords.frm
字号:
Caption = "Dy"
Height = 255
Left = 240
TabIndex = 18
Top = 600
Width = 495
End
Begin VB.Label lblDz
Caption = "Dz"
Height = 255
Left = 240
TabIndex = 17
Top = 960
Width = 495
End
Begin VB.Label lblEx
Caption = "Ex"
Height = 255
Left = 2520
TabIndex = 16
Top = 240
Width = 615
End
Begin VB.Label lblEy
Caption = "Ey"
Height = 255
Left = 2520
TabIndex = 15
Top = 600
Width = 615
End
Begin VB.Label lblEz
Caption = "Ez"
Height = 255
Index = 0
Left = 2520
TabIndex = 14
Top = 960
Width = 615
End
Begin VB.Label lblMScale
Caption = "mScale"
Height = 255
Left = 240
TabIndex = 13
Top = 1320
Width = 615
End
End
End
Begin VB.Frame Frame1
Caption = "自定义坐标系统转换设置"
Height = 4875
Left = 120
TabIndex = 1
Top = 480
Width = 4815
Begin VB.OptionButton OptBJ54ToWGS84
Caption = "新北京54－WGS84"
Height = 375
Left = 960
TabIndex = 3
Top = 2520
Width = 2055
End
Begin VB.OptionButton OptBJ54ToTWD67ToTWD97
Caption = "新北京54－TWD67－TWD97"
Height = 495
Left = 960
TabIndex = 2
Top = 1800
Value = -1 'True
Width = 2535
End
End
End
End
Attribute VB_Name = "frmDefineCoord"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************************************
'文 件 名：frmShpTrans.frm
'描 述：自定义转换设置窗体
'作 者：王来刚
'建立日期：2005年11月15日
'修 改 者：
'修改日期：
'修改内容：（简要说明修改的原因、内容，如改动很大，将改动前的源程序列在文件头注释中）
'修 改 者：
'修改日期：
'修改内容：
'*********************************************************************************
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
On Error GoTo er
If Me.OptBJ54ToWGS84.Value = True Then
miConvMode = 1 '设置转换模式
ElseIf Me.OptBJ54ToTWD67ToTWD97.Value = True Then
miConvMode = 2
End If
If Not CheckValid() Then Exit Sub
'将转换参数传给公用变量
If OptBJ54ToWGS84.Value Then
'北京54到WGS84之间的转换参数
m_dDx_1 = CDbl(txtDx_1.Text)
m_dDy_1 = CDbl(txtDy_1.Text)
m_dDz_1 = CDbl(txtDz_1.Text)
m_dEx_1 = CDbl(txtEx_1.Text)
m_dEy_1 = CDbl(txtEy_1.Text)
m_dEz_1 = CDbl(txtEz_1.Text)
m_dm_1 = CDbl(txtmScale_1.Text)
m_dBJ54A_1 = CDbl(txtBJ54A_1.Text)
m_dBJ54F_1 = CDbl(txtBJ54F_1.Text)
m_dWGS84A_1 = CDbl(txtWGS84A_1.Text)
m_dWGS84F_1 = CDbl(txtWGS84F_1.Text)
ElseIf OptBJ54ToTWD67ToTWD97.Value Then
'北京54到TWD67转换的参数
m_dDx_2 = CDbl(txtDX_2.Text)
m_dDy_2 = CDbl(txtDy_2.Text)
m_dDz_2 = CDbl(txtDz_2.Text)
m_dEx_2 = CDbl(txtEx_2.Text)
m_dEy_2 = CDbl(txtEy_2.Text)
m_dEz_2 = CDbl(txtEz_2.Text)
m_dm_2 = CDbl(txtMScale_2.Text)
m_dBJ54A_2 = CDbl(txtBJ54A_2.Text)
m_dBJ54F_2 = CDbl(txtBJ54F_2.Text)
m_dTWD67A_2 = CDbl(txtTWD67A_2.Text)
m_dTWD67F_2 = CDbl(txtTWD67F_2.Text)
'TWD67再到TWD97转换的参数
m_dDx_3 = CDbl(txtDX_3.Text)
m_dDy_3 = CDbl(txtDY_3.Text)
m_dDz_3 = CDbl(txtDZ_3.Text)
m_dm_3 = CDbl(txtMSCale_3.Text)
m_dTwd67A_3 = CDbl(txtTWD67A_3.Text)
m_dTwd67F_3 = CDbl(txtTWD67F_3.Text)
m_dTwd97A_3 = CDbl(txtTWD97A_3.Text)
m_dTwd97F_3 = CDbl(txtTWD97F_3.Text)
End If
'--------------------测试坐标转换参数------------------
' Dim Dx As Double
' Dim Dy As Double
' Dx = 120
' Dy = 23
' Dim dX1 As Double
' Dim dY1 As Double
' InitPara -1
' BLCoorTrans54to84DefineEx Dx, Dy, 1, dX1, dY1
' Debug.Print dX1, dY1
' Stop
'--------------------测试坐标转换参数------------------
Unload Me
Exit Sub
er:
MsgBox "请输入数字型参数", vbCritical + vbOKOnly, "错误！"
End Sub
Private Sub Form_Load()
WindowsXPC1.FrameControl = False
WindowsXPC1.InitSubClassing
InitializeMe
End Sub
Private Sub Form_Unload(Cancel As Integer)
WindowsXPC1.EndWinXPCSubClassing
End Sub
'-----------------
'检查数据输入合法行
'如果错误则直接定位到发生错误的控件上
'发现错误后首先转到对应的Tab页面，然后
'定位到相应的输入数据框内
'-----------------
Private Function CheckValid() As Boolean
On Error GoTo errHandler
CheckValid = False
If OptBJ54ToWGS84.Value Then
'检查FraBj54ToWGS84内容
If Trim$(txtBJ54A_1.Text) = "" Then
MsgBox "北京54椭球体长半轴不能为空值.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtBJ54A_1.SetFocus
Exit Function
Else
If Not IsNumeric(Trim$(txtBJ54A_1.Text)) Then
MsgBox "北京54椭球体长半轴输入值非法,请返回检查.", vbOKOnly + vbInformation, "提示"
SetCurTab 1 '返回到对应的Tab页面
txtBJ54A_1.SetFocus
Exit Function
End If
End If
If Trim$(txtBJ54F_1.Text) = "" Then
MsgBox "北京54椭球体扁率不能为空值.", vbOKOnly + vbInformation, "提示"
SetCurTab 1 '返回到对应的Tab页面
txtBJ54F_1.SetFocus
Exit Function
Else
If Not IsNumeric(Trim$(txtBJ54F_1.Text)) Then
MsgBox "北京54椭球体扁率输入值非法,请返回检查.", vbOKOnly + vbInformation, "提示"
SetCurTab 1 '返回到对应的Tab页面
txtBJ54F_1.SetFocus
Exit Function
End If
End If
If Trim$(txtWGS84A_1.Text) = "" Then
MsgBox "WGS84椭球体长半轴不能为空值.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtWGS84A_1.SetFocus '返回到对应的Tab页面
Exit Function
Else
If Not IsNumeric(Trim$(txtWGS84A_1.Text)) Then
MsgBox "WGS84椭球体长半轴输入值非法,请返回检查.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtWGS84A_1.SetFocus
Exit Function
End If
End If
If Trim$(txtWGS84F_1.Text) = "" Then
MsgBox "WGS84椭球体扁率不能为空值.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtWGS84F_1.SetFocus '返回到对应的Tab页面
Exit Function
Else
If Not IsNumeric(Trim$(txtWGS84F_1.Text)) Then
MsgBox "WGS84椭球体扁率输入值非法,请返回检查.", vbOKOnly + vbInformation, "提示"
SetCurTab 1 '返回到对应的Tab页面
txtWGS84F_1.SetFocus
Exit Function
End If
End If
If Trim$(txtDx_1.Text) = "" Then
MsgBox "DX值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 1 '返回到对应的Tab页面
txtDx_1.SetFocus '返回到对应的Tab页面
Exit Function
Else
If Not IsNumeric(txtDx_1.Text) Then
MsgBox "DX输入值非法,请检查输入.", vbOKOnly + vbInformation, "提示"
SetCurTab 1 '返回到对应的Tab页面
txtDx_1.SetFocus '返回到对应的Tab页面
Exit Function
End If
End If
If Trim$(txtDy_1.Text) = "" Then
MsgBox "DY值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtEy_1.SetFocus '返回到对应的Tab页面
Exit Function
Else
If Not IsNumeric(txtDy_1.Text) Then
MsgBox "DY值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtDy_1.SetFocus
Exit Function
End If
End If
If Trim$(txtDz_1.Text) = "" Then
MsgBox "DY值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtDz_1.SetFocus
Exit Function
Else
If Not IsNumeric(txtDz_1.Text) Then
MsgBox "EZ值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtDz_1.SetFocus
Exit Function
End If
End If
If Trim$(txtEx_1.Text) = "" Then
MsgBox "EX值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 2
txtEx_1.SetFocus '返回到对应的Tab页面
Exit Function
Else
If Not IsNumeric(txtEx_1.Text) Then
MsgBox "EX输入值非法,请检查输入.", vbOKOnly + vbInformation, "提示"
SetCurTab 1 '返回到对应的Tab页面
txtEx_1.SetFocus
Exit Function
End If
End If
If Trim$(txtEy_1.Text) = "" Then
MsgBox "EY值不能为空.", vbOKOnly + vbInformation, "提示"
txtEy_1.SetFocus '返回到对应的Tab页面
Exit Function
Else
If Not IsNumeric(txtEy_1.Text) Then
MsgBox "EY值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtEy_1.SetFocus '返回到对应的Tab页面
Exit Function
End If
End If
If Trim$(txtEz_1.Text) = "" Then
MsgBox "EY值不能为空.", vbOKOnly + vbInformation, "提示"
txtEz_1.SetFocus '返回到对应的Tab页面
Exit Function
Else
If Not IsNumeric(txtEz_1.Text) Then
MsgBox "EZ值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtEz_1.SetFocus
Exit Function
End If
End If
If Trim$(txtmScale_1.Text) = "" Then
MsgBox "mScale值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 1 '返回到对应的Tab页面
txtmScale_1.SetFocus
Exit Function
Else
If Not IsNumeric(txtmScale_1.Text) Then
MsgBox "mScale值不能为空.", vbOKOnly + vbInformation, "提示"
SetCurTab 1
txtmScale_1.SetFocus '返回到对应的Tab页面
Exit Function
End If
End If
Else
'---------------------------------------------------------------
'检查另外的坐标转换参数
'BJ54-TWD67-TWD97
If Trim$(txtBJ54A_2.Text) = "" Then
MsgBox "北京54椭球体长半轴不能为空值.", vbOKOnly + vbInformation, "提示"
SetCurTab 2 '返回到对应的Tab页面
txtBJ54A_2.SetFocus
Exit Function
Else
If Not IsNumeric(Trim$(txtBJ54A_2.Text)) Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -