📄 frmconvert.frm
字号:
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 2
Left = 4800
TabIndex = 2
Top = 248
Width = 255
End
Begin VB.Label Label1
Caption = "角度:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 3
Left = 4560
TabIndex = 1
Top = 728
Width = 615
End
End
Begin VB.Menu mnuFile
Caption = "文件"
Begin VB.Menu mnuSave
Caption = "保存"
End
Begin VB.Menu mnuQuit
Caption = "退出"
End
End
Begin VB.Menu mnuConvert
Caption = "坐标转换"
Begin VB.Menu mnuPing
Caption = "平面坐标转换"
End
Begin VB.Menu mnuGao
Caption = "高斯坐标转换"
End
End
Begin VB.Menu mnuHuan
Caption = "坐标换带"
End
End
Attribute VB_Name = "frmConvert"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdConvertG_Click()
If OptDy.Value = True Then
Call 大地到高斯
Else
Call 高斯到大地
End If
End Sub
Private Sub cmdConvertP_Click()
Dim i, j, h As Integer
Dim x() As Double
Dim y() As Double
Dim p, q, k, degree As Double
'计算总数
For i = 1 To 100
If Grid1.Cell(i, 1).Text = "" Then Exit For
Next i
counter = i - 1
If txtP.Text = "" Or txtQ.Text = "" Or txtK.Text = "" Or txtD.Text = "" Then
MsgBox (" 请先计算参数！")
Exit Sub
End If
If counter < 1 Then
MsgBox (" 点数太少，怎么算？")
Exit Sub
End If
'付值
p = txtP.Text
q = txtQ.Text
k = txtK.Text
degree = txtD.Text
'计算坐标
ReDim x(counter), y(counter) As Double
For j = 0 To counter - 1
x(j) = Grid1.Cell(j + 1, 1).Text
y(j) = Grid1.Cell(j + 1, 2).Text
Next j
For h = 0 To counter - 1
Grid2.Cell(h + 1, 1).Text = p + k * x(h) * Cos(degree) - k * y(h) * Sin(degree)
Grid2.Cell(h + 1, 2).Text = q + k * y(h) * Cos(degree) + k * x(h) * Sin(degree)
Next h
End Sub
Private Sub cmdConvetH_Click()
'变量定义
Dim i, j, counter As Integer
Dim x(), y() As Double
Dim pt, z, n, b0, b2, b3, b4, b5, a0, a3, a4, a5, a6, l01, l02, p, pi As Double
Dim b, l As Double
Dim xm, ym As Double
For i = 1 To 100
If Grid6.Cell(i, 1).Text = "" Then Exit For
Next i
counter = i - 1
If txtYuan.Text = "" Or txtMuBiao.Text = "" Then
MsgBox (" 中央子午线不能为空！")
Exit Sub
End If
If counter < 1 Then
MsgBox (" 点数太少，怎么算？")
Exit Sub
End If
p = 57.295779513
pi = 3.1415926
l01 = CDbl(Trim(txtYuan.Text))
l01 = (l01 / 180) * pi
l02 = CDbl(Trim(txtMuBiao.Text))
l02 = (l02 / 180) * pi
p = (p / 180) * pi
j = 1
ReDim x(counter), y(counter)
Do
x(j) = Grid6.Cell(j, 1).Text
y(j) = Grid6.Cell(j, 2).Text - 500000
pt = x(j) * p / 6367558.497
b0 = pt + (50221746 + (293622 + (2350 + 22 * Cos(pt) ^ 2) * Cos(pt) ^ 2) * Cos(pt) ^ 2) * Sin(pt) * Cos(pt) * p * 10 ^ (-10)
n = 6399698.902 - (21562.267 - (108.973 - 0.612 * Cos(b0) ^ 2) * Cos(b0) ^ 2) * Cos(b0) ^ 2
z = y(j) / (n * Cos(b0))
b2 = (0.5 + 0.003369 * Cos(b0) ^ 2) * Sin(b0) * Cos(b0)
b3 = 0.333333 - (0.166667 - 0.001123 * Cos(b0) ^ 2) * Cos(b0) ^ 2
b4 = 0.25 + (0.16161 + 0.00562 * Cos(b0) ^ 2) * Cos(b0) ^ 2
b5 = 0.2 - (0.1667 - 0.0088 * Cos(b0) ^ 2) * Cos(b0) ^ 2
b = b0 - (1 - (b4 - 0.125 * z ^ 2) * z ^ 2) * z ^ 2 * b2 * p
l = (1 - (b3 - b5 * z ^ 2) * z ^ 2) * z * p
l = l01 + l
'***********
l = (l - l02) / p
n = 6399698.902 - (21562.267 - (108.973 - (0.612 - 0.004 * Cos(b) ^ 2) * Cos(b) ^ 2) * Cos(b) ^ 2) * Cos(b) ^ 2
a0 = 32140.4048 - (135.3303 - (0.7092 - 0.0041 * Cos(b) ^ 2) * Cos(b) ^ 2) * Cos(b) ^ 2
a3 = (0.3333333 + 0.001123 * Cos(b) ^ 2) * Cos(b) ^ 2 - 0.1666667
a4 = (0.25 + 0.00253 * Cos(b) ^ 2) * Cos(b) ^ 2 - 0.04167
a5 = 0.00833 - (0.1667 - (0.1967 - 0.004 * Cos(b) ^ 2) * Cos(b) ^ 2) * Cos(b) ^ 2
a6 = (0.167 * Cos(b) ^ 2 - 0.083) * Cos(b) ^ 2
xm = 6367558.497 * (b / p) - (a0 - (0.5 + (a4 + a6 * l ^ 2) * l ^ 2) * l ^ 2 * n) * Sin(b) * Cos(b)
ym = (1 + (a3 + a5 * l ^ 2) * l ^ 2) * l * n * Cos(b)
Grid5.Cell(j, 1).Text = xm
Grid5.Cell(j, 2).Text = ym + 500000
j = j + 1
Loop While j <= counter
End Sub
Private Sub cmdExitG_Click()
framGauss.Visible = False
framBg.Visible = True
End Sub
Private Sub cmdExitP_Click()
framPing.Visible = False
framBg.Visible = True
End Sub
Private Sub cmdExitH_Click()
framHuan.Visible = False
framBg.Visible = True
End Sub
Private Sub cmdPmt_Click()
frmPmt.Show
End Sub
Private Sub Form_Load()
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^"
Grid2.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^"
Grid3.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^"
Grid4.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^"
Grid5.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^"
Grid6.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^"
With Grid1
.OpenFile (App.Path & "\p1.cel")
End With
With Grid2
.OpenFile (App.Path & "\p2.cel")
End With
With Grid3
.OpenFile (App.Path & "\d.cel")
End With
With Grid4
.OpenFile (App.Path & "\g.cel")
End With
With Grid5
.OpenFile (App.Path & "\g.cel")
End With
With Grid6
.OpenFile (App.Path & "\g.cel")
End With
End Sub
Private Sub mnuGao_Click()
Dim i As Integer
framBg.Visible = False
framPing.Visible = False
framHuan.Visible = False
framGauss.Visible = True
For i = 1 To 100
Grid3.Cell(i, 1).Text = ""
Grid3.Cell(i, 2).Text = ""
Grid4.Cell(i, 1).Text = ""
Grid4.Cell(i, 2).Text = ""
Next i
End Sub
Private Sub mnuPing_Click()
Dim i As Integer
framBg.Visible = False
framGauss.Visible = False
framHuan.Visible = False
framPing.Visible = True
For i = 1 To 100
Grid1.Cell(i, 1).Text = ""
Grid1.Cell(i, 2).Text = ""
Grid2.Cell(i, 1).Text = ""
Grid2.Cell(i, 2).Text = ""
Next i
End Sub
Private Sub mnuHuan_Click()
Dim i As Integer
framBg.Visible = False
framPing.Visible = False
framGauss.Visible = False
framHuan.Visible = True
For i = 1 To 100
Grid5.Cell(i, 1).Text = ""
Grid5.Cell(i, 2).Text = ""
Grid6.Cell(i, 1).Text = ""
Grid6.Cell(i, 2).Text = ""
Next i
End Sub
Private Sub mnuQuit_Click()
End
End Sub
Sub 大地到高斯()
'变量定义
Dim i, j, counter As Integer
Dim b(), l() As Double
Dim n, a0, a3, a4, a5, a6, p, pi, l0 As Double
Dim x, y As Double
For i = 1 To 100
If Grid3.Cell(i, 1).Text = "" Then Exit For
Next i
counter = i - 1
If txtCenter.Text = "" Then
MsgBox (" 中央子午线不能为空！")
Exit Sub
End If
If counter < 1 Then
MsgBox (" 点数太少，怎么算？")
Exit Sub
End If
p = 57.295779513
pi = 3.1415926
l0 = CDbl(Trim(txtCenter.Text))
l0 = (l0 / 180) * pi
p = (p / 180) * pi
j = 1
ReDim b(counter), l(counter)
Do
b(j) = Grid3.Cell(j, 1).Text
l(j) = Grid3.Cell(j, 2).Text
b(j) = Int(b(j)) + Int((b(j) - Int(b(j))) * 100) / 60 + (((b(j) - Int(b(j))) * 100 - Int((b(j) - Int(b(j))) * 100)) * 100) / 3600
l(j) = Int(l(j)) + Int((l(j) - Int(l(j))) * 100) / 60 + (((l(j) - Int(l(j))) * 100 - Int((l(j) - Int(l(j))) * 100)) * 100) / 3600
b(j) = (b(j) / 180) * pi
l(j) = (l(j) / 180) * pi
l(j) = (l(j) - l0) / p
n = 6399698.902 - (21562.267 - (108.973 - (0.612 - 0.004 * Cos(b(j)) ^ 2) * Cos(b(j)) ^ 2) * Cos(b(j)) ^ 2) * Cos(b(j)) ^ 2
a0 = 32140.4048 - (135.3303 - (0.7092 - 0.0041 * Cos(b(j)) ^ 2) * Cos(b(j)) ^ 2) * Cos(b(j)) ^ 2
a3 = (0.3333333 + 0.001123 * Cos(b(j)) ^ 2) * Cos(b(j)) ^ 2 - 0.1666667
a4 = (0.25 + 0.00253 * Cos(b(j)) ^ 2) * Cos(b(j)) ^ 2 - 0.04167
a5 = 0.00833 - (0.1667 - (0.1967 - 0.004 * Cos(b(j)) ^ 2) * Cos(b(j)) ^ 2) * Cos(b(j)) ^ 2
a6 = (0.167 * Cos(b(j)) ^ 2 - 0.083) * Cos(b(j)) ^ 2
x = 6367558.497 * (b(j) / p) - (a0 - (0.5 + (a4 + a6 * l(j) ^ 2) * l(j) ^ 2) * l(j) ^ 2 * n) * Sin(b(j)) * Cos(b(j))
y = (1 + (a3 + a5 * l(j) ^ 2) * l(j) ^ 2) * l(j) * n * Cos(b(j))
Grid4.Cell(j, 1).Text = x
Grid4.Cell(j, 2).Text = y + 500000
j = j + 1
Loop While j <= counter
End Sub
Sub 高斯到大地()
'变量定义
Dim i, j, counter As Integer
Dim x(), y() As Double
Dim pt, z, n, b0, b2, b3, b4, b5, p, pi, l0 As Double
Dim b, l As Double
For i = 1 To 100
If Grid3.Cell(i, 1).Text = "" Then Exit For
Next i
counter = i - 1
If txtCenter.Text = "" Then
MsgBox (" 中央子午线不能为空！")
Exit Sub
End If
If counter < 1 Then
MsgBox (" 点数太少，怎么算？")
Exit Sub
End If
p = 57.295779513
pi = 3.1415926
l0 = CDbl(Trim(txtCenter.Text))
l0 = (l0 / 180) * pi
p = (p / 180) * pi
j = 1
ReDim x(counter), y(counter)
Do
x(j) = Grid3.Cell(j, 1).Text
y(j) = Grid3.Cell(j, 2).Text - 500000
pt = x(j) * p / 6367558.497
b0 = pt + (50221746 + (293622 + (2350 + 22 * Cos(pt) ^ 2) * Cos(pt) ^ 2) * Cos(pt) ^ 2) * Sin(pt) * Cos(pt) * p * 10 ^ (-10)
n = 6399698.902 - (21562.267 - (108.973 - 0.612 * Cos(b0) ^ 2) * Cos(b0) ^ 2) * Cos(b0) ^ 2
z = y(j) / (n * Cos(b0))
b2 = (0.5 + 0.003369 * Cos(b0) ^ 2) * Sin(b0) * Cos(b0)
b3 = 0.333333 - (0.166667 - 0.001123 * Cos(b0) ^ 2) * Cos(b0) ^ 2
b4 = 0.25 + (0.16161 + 0.00562 * Cos(b0) ^ 2) * Cos(b0) ^ 2
b5 = 0.2 - (0.1667 - 0.0088 * Cos(b0) ^ 2) * Cos(b0) ^ 2
b = b0 - (1 - (b4 - 0.125 * z ^ 2) * z ^ 2) * z ^ 2 * b2 * p
l = (1 - (b3 - b5 * z ^ 2) * z ^ 2) * z * p
l = l0 + l
b = (b / pi) * 180
l = (l / pi) * 180
b = Int(b) + (b - Int(b)) * 60 / 100
l = Int(l) + (l - Int(l)) * 60 / 100
b = Int(b * 100) + (b * 100 - Int(b * 100)) * 60 / 100
l = Int(l * 100) + (l * 100 - Int(l * 100)) * 60 / 100
b = b / 100
l = l / 100
Grid4.Cell(j, 1).Text = b
Grid4.Cell(j, 2).Text = l
j = j + 1
Loop While j <= counter
End Sub
Private Sub mnuSave_Click()
If framPing.Visible = True Then
f = Grid2.ExportToExcel("", True, False)
MsgBox (" 文件保存完毕！")
End If
If framGauss.Visible = True Then
f = Grid4.ExportToExcel("", True, False)
MsgBox (" 文件保存完毕！")
End If
If framHuan.Visible = True Then
f = Grid5.ExportToExcel("", True, False)
MsgBox (" 文件保存完毕！")
End If
End Sub
Private Sub OptDy_Click()
With Grid3
.OpenFile (App.Path & "\d.cel")
End With
With Grid4
.OpenFile (App.Path & "\g.cel")
End With
End Sub
Private Sub OptGy_Click()
With Grid3
.OpenFile (App.Path & "\g.cel")
End With
With Grid4
.OpenFile (App.Path & "\d.cel")
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -