gaositouyingzhengfansuan.txt

这是高斯投影正反算的VB源代码

'采用1975年国际椭球体参数

Dim n%      'n是带号
Const a = 6378140, bb = 6356755.28815753      '以米为单位,bb为椭球短半轴
Const PI = 3.14159265358979

Private Sub Command1_Click()
    
    If Text3.Text = "" Or Text4.Text = "" Then
        response = MsgBox("请输入数据！", vbOKOnly, "提示")
    End If
    If response = vbOK Then
        Exit Sub
    End If
        
    If Option1(2).Value = False And Option1(3).Value = False Then
        response = MsgBox("请选择投影带！", vbOKOnly, "提示")
    End If
    If response = vbOK Then
        Exit Sub
    End If
        
    
    
    X = Val(Text3.Text)
    YY = Val(Text4.Text)
    Y = YY - 500000
    
        
    aa = Sqr((a + bb) * (a - bb))
    e1 = aa / a       'e1为第一偏心率
    e2 = aa / bb      'e2为第二偏心率
    
    β = X / 6367452.133    'β以弧度为单位
    cβ = Cos(β)
    Bf = β + (50228976 + (293697 + (2383 + 22 * cβ ^ 2) * cβ ^ 2) * cβ ^ 2) * 10 ^ -10 * Sin(β) * cβ
    
    tf = Tan(Bf)
    sf = Sin(Bf)
    cf = Cos(Bf)
    ηf = e2 * cf
    
    m0 = a * (1 - e1 ^ 2)
    m2 = 1.5 * e1 ^ 2 * m0
    m4 = 1.25 * e1 ^ 2 * m2
    m6 = 7 / 6 * e1 ^ 2 * m4
    m8 = 9 / 8 * e1 ^ 2 * m6
    Mf = m0 + m2 * sf ^ 2 + m4 * sf ^ 4 + m6 * sf ^ 6 + m8 * sf ^ 8
    
    n0 = a
    n2 = 0.5 * e1 * e1 * n0
    n4 = 0.75 * e1 * e1 * n2
    n6 = 5 / 6 * e1 * e1 * n4
    n8 = 0.875 * e1 * e1 * n6
    Nf = n0 + n2 * sf ^ 2 + n4 * sf ^ 4 + n6 * sf ^ 6 + n8 * sf ^ 8
            
    p1 = tf / (2 * Mf * Nf) * Y ^ 2
    p2 = tf / (24 * Mf * Nf ^ 3) * (5 + 3 * tf ^ 3 + ηf ^ 3 - 9 * ηf ^ 2 * tf ^ 2) * Y ^ 4
    p3 = tf / (720 * Mf * Nf ^ 5) * (61 + 90 * tf ^ 2 + 45 * tf ^ 4) * Y ^ 6
    b = Bf - p1 + p2 - p3       'b为大地纬度
    
    q1 = Y / (Nf * cf)
    q2 = (1 + 2 * tf ^ 2 + ηf ^ 2) * Y ^ 3 / (6 * Nf ^ 3 * cf)
    q3 = (5 + 28 * tf ^ 2 + 24 * tf ^ 4 + 6 * ηf ^ 2 + 8 * ηf ^ 2 * tf ^ 2) * Y ^ 5 / (120 * Nf ^ 5 * cf)
    ll = q1 - q2 + q3       'll为大地经度与中央子午线的经差
    
    a2 = ll / PI * 180
    
    
    If Option1(2).Value = True Then     'L0以度为单位
        L0 = 3 * n
    ElseIf Option1(3).Value = True Then
        L0 = 6 * n - 3
    End If
    
    L = L0 + a2     'L以度为单位
    
    a1 = b / PI * 180
    b1 = (a1 - Int(a1)) * 60
    c1 = (b1 - Int(b1)) * 60
    Text1.Text = Int(a1)
    Text2.Text = Int(b1)
    Text5.Text = c1
    
    
    b2 = (L - Int(L)) * 60
    c2 = (b2 - Int(b2)) * 60
    Text6.Text = Int(L)
    Text7.Text = Int(b2)
    Text8.Text = c2
    
End Sub

Private Sub Command2_Click()
    
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    Text6.Text = ""
    Text7.Text = ""
    Text8.Text = ""
    Option1(2).Value = False
    Option1(3).Value = False
    
End Sub

Private Sub Option1_Click(Index As Integer)
    n = Val(InputBox("请输入带号！！", "输入带号"))
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    
    'BackSpace键的KeyAscii值为8
    '小数点的KeyAscii值为46
    '如果录入的不是0-9之间的数或不是"退格"和小数点时，
    If (KeyAscii < 48 And KeyAscii <> 8 And KeyAscii <> 46) Or KeyAscii > 57 Then
        MsgBox Chr(KeyAscii) & "是非法字符"
        KeyAscii = 0
    End If
    
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
    
    'BackSpace键的KeyAscii值为8
    '小数点的KeyAscii值为46
    '如果录入的不是0-9之间的数或不是"退格"和小数点时，
    If (KeyAscii < 48 And KeyAscii <> 8 And KeyAscii <> 46) Or KeyAscii > 57 Then
        MsgBox Chr(KeyAscii) & "是非法字符"
        KeyAscii = 0
    End If
    
End Sub