【文章內容簡介】 = * B (a0 ( + (a4 + a6 * ll * ll) * ll * ll) * ll * ll * n) * Sin(B) * cosB Y = (1 + (a3 + a5 * ll * ll) * ll * ll) * ll * n * cosBEnd SubPublic Sub Pro80() 80橢球系高斯正算公式 Dim ll, n, a0, a4, a6, a3, a5, cosB cosB = Cos(B) ll = L DoToHu(L0) n = ( ( * cosB * cosB) * cosB * cosB) * cosB * cosB a0 = ( ( * cosB * cosB) * cosB * cosB) * cosB * cosB a4 = ( + * cosB * cosB) * cosB * cosB a6 = ( * cosB * cosB ) * cosB * cosB a3 = ( + * cosB * cosB) * cosB * cosB a5 = ( * cosB * cosB) * cosB * cosB X = * B (a0 ( + (a4 + a6 * ll * ll) * ll * ll) * ll * ll * n) * Sin(B) * cosB Y = (1 + (a3 + a5 * ll * ll) * ll * ll) * ll * n * cosBEnd SubPublic Sub ConPro54() 54橢球系高斯反算公式 Dim Bf, bet, Z, Nf, b2, b3, b4, b5, cos2B, cos2Bf bet = X / cos2B = Cos(bet) * Cos(bet) Bf = bet + (50221746 + (293622 + (2350 + 22 * cos2B) * cos2B) * cos2B) * * Sin(bet) * Cos(bet) cos2Bf = Cos(Bf) * Cos(Bf) Nf = ( ( * cos2Bf) * cos2Bf) * cos2Bf Z = Y / (Nf * Cos(Bf)) b2 = ( + * cos2Bf) * Sin(Bf) * Cos(Bf) b3 = ( * cos2Bf) * cos2Bf b4 = + ( + * cos2Bf) * cos2Bf b5 = ( * cos2Bf) * cos2Bf B = Bf (1 (b4 * Z * Z) * Z * Z) * Z * Z * b2 L = DoToHu(L0) + (1 (b3 b5 * Z * Z) * Z * Z) * ZEnd SubPublic Sub ConPro80() 80橢球系高斯反算公式 Dim Bf, bet, Z, Nf, b2, b3, b4, b5, cos2B, cos2Bf bet = X / cos2B = Cos(B) * Cos(B) Bf = bet + (50221746 + (293622 + (2350 + 22 * cos2B) * cos2B) * cos2B) * * Sin(bet) * Cos(bet) cos2Bf = Cos(Bf) * Cos(Bf) Nf = ( ( * cos2Bf) * cos2Bf) * cos2Bf Z = Y / (Nf * Cos(Bf)) b2 = ( + * cos2Bf) * Sin(Bf) * Cos(Bf) b3 = ( * cos2Bf) * cos2Bf b4 = + ( + * cos2Bf) * cos2Bf b5 = ( * cos2Bf) * cos2Bf B = Bf (1 (b4 * Z * Z) * Z * Z) * Z * Z * b2 L = DoToHu(L0) + (1 (b3 b5 * Z * Z) * Z * Z) * ZEnd Sub39。投影計算Private Sub cmdCalc_Click()B = Val() L = Val() X = Val(): Y = Val(Mid(, 3)) 39。計算中央子午線經度和帶號 If = True Then 39。正算 If lenL = 6 Then n = Int(L / lenL + 1)L0 = n * lenL lenL / 2ElseIf lenL = 3 Then n = Int((L ) / lenL + 1) L0 = n * lenLEnd If ElseIf = True Then 39。反算 n = Val(Left(, 2)) If lenL = 6 ThenL0 = n * lenL lenL / 2ElseIf lenL = 3 Then L0 = n * lenLEnd If End If B = DoToHu(B) L = DoToHu(L) 39。根據橢球進行投影計算 If = True Then 39。正算 If = 0 Then 39。54 Call Pro54 調用54橢球系高斯正算公式 ElseIf = 1 Then 39。80 Call Pro80 調用80橢球系高斯正算公式 End If 39。Y坐標加500公里加帶號 Y = Y + n * 1000000 + 500000 = Format(X, ) = Format(Y, ) ElseIf = True Then 39。反算 39。Y坐標還要再減500km Y = Y 500000 If = 0 Then 39。54 Call ConPro54 調用54橢球系高斯反算公式 ElseIf = 1 Then 39。80 Call ConPro80 調用80橢球系高斯反算公式 End If = Format(HuToDo(B), ) = Format(HuToDo(L), ) End IfEnd Sub39。換帶計算Private Sub cmdChange_Click() 6度帶和3度的換帶選擇X = Val(): Y = Val(Mid(, 3)) 39。Y坐標還要再減500km Y = Y 50000039。 計算開始的中央子午線經度和帶號 n = Val(Left(, 2)) If lenL = 6 Then L0 = lenL * n 3 ElseIf lenL = 3 Then L0 = lenL * n End If 39。根據橢球進行投影反算 If = 0 Then 39。54 Call ConPro54 ElseIf = 1 Then 39。80 Call ConPro80 End If 39。計算目標中央子午線經度和帶號 lenL = IIf(lenL = 6, 3, 6) If lenL = 6 Then n = Int(HuToDo(L) / lenL + 1)L0 = n * lenL lenL / 2ElseIf lenL = 3 Then n = Int((HuToDo(L) ) / lenL + 1) L0 = n * lenLEnd If 39。根據橢球進行投影計算 If = 0 Then 39。54 Call Pro54 ElseIf = 1 Then 39。80 Call Pro80 End If 39。Y坐標加500公里加帶號 Y = Y + n * 1000000 + 500000 = Format(X, ) = Format(Y, )End Sub39。臨帶計算Private Sub cmdNear_Click()X = Val(): Y = Val(Mid(, 3)) 39。Y坐標還要再減500km Y = Y 500000 39。計算開始的中央子午線經度和帶號 n = Val(Left(, 2)) If lenL = 6 Then L0 = n * lenL lenL / 2 ElseIf lenL = 3 Then L0 = n * lenLEnd If 39。根據橢球進行投影反算 If = 0 Then 39。54 Call ConPro54 ElseIf = 1 Then 39。80 Call ConPro80 End If 39。計算目標中央子午線經度和帶號 L = HuToDo(L) If L L0 Then n = n + 1 ElseIf L L0 Then n = n 1 End If L0 = IIf(L L0, L0 + lenL, L0 lenL) L = DoToHu(L) 39。根據橢球進行投影計算 If = 0 Then 39。54 Call Pro54 ElseIf = 1 Then 39。80 Call Pro80 End If 39。Y坐標加500公里加帶號 Y = Y + n * 1000000 + 500000 = Format(X, ) = Format(Y, )End SubPrivate Sub Command1_Click()Dim du As Double Dim fen As Double Dim miao As Doubledu = fen = miao = = (du + fen / 60 + miao / 3600) * / 180 End SubPrivate Sub Command2_Click()Dim hd As DoubleDim jd As Doublehd = jd = hd * 180 / = Fix(jd) = Fix((jd Fix(jd)) * 100) = (jd Fix(jd) Fix((jd Fix(jd)) * 100) / 100) * 10000End SubPrivate Sub Frame3_DragDrop(Source As Control, X As Single, Y As Single)Private Sub Form_Load() 39。初始化組合框 北京1954參考橢球 西安1980參考橢球 = 0 39。初始化參數 lenL = 6End SubPrivate Sub opt3du_Click() = 3176。6176。 lenL = 3End SubPrivate Sub opt6du_Click() = 6176。3176。 lenL = 6End SubPrivate Sub optCon_Click() = xyBL = False = False = True = True End SubPrivate Sub optTran_Click() = BLxy = True = True = False = False End Sub本程序要實現(xiàn)的功能是根據所選擇的橢球參數和指定的分帶情況，將已知地理坐標或高斯投影坐標經正算和反算求得相應的高斯坐標和地理坐標，以及相應的換帶計算和臨帶計算。因此需要用一個框架控件來組織橢球參數、兩個框架分別組織分