formguassf.frm

用VB编写的水准平差软件

dB = B2 - B1
Bm = (B1 + B2) / 2
Nm = GetN(Bm)
Vm = GetV(Bm)
tm = Gett(Bm)
nnm = Getnn(Bm)
r01 = Nm * Cos(Bm): r21 = r01 / (24 * Vm * Vm * Vm * Vm) * (1 + nnm - 9 * nnm * tm * tm): r03 = -r01 * Cos(Bm) * Cos(Bm) * tm * tm / 24
S10 = Nm / (Vm * Vm): S12 = -S10 / 24 * Cos(Bm) * Cos(Bm) * (2 + 3 * tm * tm + 3 * tm * tm * nnm): S30 = -S10 / (8 * Vm * Vm * Vm * Vm) * nnm * (tm * tm - 1 - nnm - 4 * nnm * tm * tm)
t01 = tm * Cos(Bm): t21 = t01 / 24 * (3 + 2 * nnm - 2 * nnm * nnm): t03 = t01 / 12 * Cos(Bm) * Cos(Bm) * (1 + nnm)
U = r01 * dl + r21 * dB * dB * dl + r03 * dl * dl * dl
V = S10 * dB + S12 * dB * dl * dl + S30 * dB * dB * dB
dAm = t01 * dl + t21 * dB * dB * dl + t03 * dl * dl * dl
'Am = Atn(U / V)
y = Abs(U / V)
o = Abs(V / U)
If (Abs(dB) >= Abs(dl)) Then
t = Atn(y)
Else
t = PI / 4 + Atn((1 - o) / (1 + o))
End If
If (dB > 0 And dl >= 0) Then
Am = t
ElseIf (dB < 0 And dl >= 0) Then
Am = PI - t
ElseIf (dB <= 0 And dl < 0) Then
Am = PI + t
ElseIf (dB > 0 And dl < 0) Then
Am = 2 * PI - t
Else
Am = PI / 2
End If
Text_A12.Text = Round(RadianToAngle(Am - dAm / 2), 8)
Text_A21.Text = Round(RadianToAngle(Am + dAm / 2 + PI), 8)
Text_S.Text = Round(U / Sin(Am), 4)
Text_A12.Enabled = True
Text_A21.Enabled = True
Text_S.Enabled = True
Text_A12.BackColor = &H8000000E
Text_A21.BackColor = &H8000000E
Text_S.BackColor = &H8000000E

End If


End Sub




Private Sub Command2_Click()
Dim txt As String
'Dim txt() As Double
Dim i As Integer
CommonDialog1.ShowOpen
If (CommonDialog1.FileName <> "") Then
Open CommonDialog1.FileName For Input As #12
Dim ccc As Integer
ccc = 1
Do While Not EOF(12)
Line Input #12, txt
BBmat = Split(txt, ",", -1, 1)
Command3.Enabled = True
B1 = AngleToRadian(Val(BBmat(0)))
B2 = AngleToRadian(Val(BBmat(1)))
L1 = AngleToRadian(Val(BBmat(2)))
L2 = AngleToRadian(Val(BBmat(3)))
dl = L2 - L1
dB = B2 - B1
Bm = (B1 + B2) / 2
Nm = GetN(Bm + 0)
Vm = GetV(Bm + 0)
tm = Gett(Bm + 0)
nnm = Getnn(Bm + 0)
r01 = Nm * Cos(Bm): r21 = r01 / (24 * Vm * Vm * Vm * Vm) * (1 + nnm - 9 * nnm * tm * tm): r03 = -r01 * Cos(Bm) * Cos(Bm) * tm * tm / 24
S10 = Nm / (Vm * Vm): S12 = -S10 / 24 * Cos(Bm) * Cos(Bm) * (2 + 3 * tm * tm + 3 * tm * tm * nnm): S30 = -S10 / (8 * Vm * Vm * Vm * Vm) * nnm * (tm * tm - 1 - nnm - 4 * nnm * tm * tm)
't01 = tm * Cos(Bm): t21 = t01 / 24 * (3 + 2 * nnm - 2 * nnm * nnm): t03 = t01 / 12 * Cos(Bm) * Cos(Bm) * (1 + nnm)
U = r01 * dl + r21 * dB * dB * dl + r03 * dl * dl * dl
V = S10 * dB + S12 * dB * dl * dl + S30 * dB * dB * dB
dAm = U * tm / Nm * (1 + (V * V * (2 + 7 * nnm + 9 * tm * tm * nnm + 5 * nnm * nnm) + U * U * (2 + tm * tm + 2 * nnm)) / 24)
'dAm = t01 * dL + t21 * dB * dB * dL + t03 * dL * dL * dL
'Am = Atn(U / V)
y = Abs(U / V)
o = Abs(V / U)
If (Abs(dB) >= Abs(dl)) Then
t = Atn(y)
Else
t = PI / 4 + Atn((1 - o) / (1 + o))
End If
If (dB > 0 And dl >= 0) Then
Am = t
ElseIf (dB < 0 And dl >= 0) Then
Am = PI - t
ElseIf (dB <= 0 And dl < 0) Then
Am = PI + t
ElseIf (dB > 0 And dl < 0) Then
Am = 2 * PI - t
Else
Am = PI / 2
End If
BBmat(0) = Round(RadianToAngle(Am - dAm / 2), 8)
BBmat(1) = Round(RadianToAngle(Am + dAm / 2 + PI), 8)
BBmat(2) = Round(U / Sin(Am), 4)
ReDim Preserve CCmat(3, ccc)
For i = (ccc - 1) To ccc - 1
CCmat(0, i) = BBmat(0): CCmat(1, i) = BBmat(1): CCmat(2, i) = BBmat(2)
Next i
dd = ccc
ccc = ccc + 1
Loop
Close #12
End If

End Sub

Private Sub Command3_Click()
Dim i As Integer
Dim overwrite As Integer
CommonDialog1.ShowSave
If Dir(CommonDialog1.FileName) <> "" Then
overwrite = MsgBox("次文件已经存在，是否需要覆盖？", vbOKCancel)
If (overwrite = vbOK) Then
GoTo save
End If
Else
save: Open CommonDialog1.FileName For Output As #12
If (dd > 1) Then
For i = 0 To dd - 2
Print #12, CCmat(0, i) & "," & CCmat(1, i) + Chr(13)
Next i
Print #12, CCmat(0, dd - 1) & "," & CCmat(1, dd - 1)
Else
Print #12, CCmat(0, 0) & "," & CCmat(1, 0)
End If
Close #12
End If
End Sub

Private Sub Form_Load()
Text_A12.BackColor = &H8000000B
Text_A21.BackColor = &H8000000B
Text_S.BackColor = &H8000000B
Text_A12.Enabled = False
Text_A21.Enabled = False
Text_S.Enabled = False
Command3.Enabled = False

End Sub

Private Sub Option1_Click(Index As Integer)
a = 6378245
b_b = 6356863.01877305
c = 6399698.90178271
AA = 1 / 298.3
ee = 0.006693421622966
e_e = 0.006738525414683
End Sub

Private Sub Option2_Click()
a = 6378140
b_b = 6356755.28815753
c = 6399596.65198801
AA = 1 / 298.257
ee = 0.006694384999588
e_e = 0.006739501819473
End Sub



Private Sub Option3_Click()
a = 6378137
b_b = 6356752.3142
c = 6399593.6258
AA = 1 / 298.257223563
ee = 0.0066943799013
e_e = 0.00673949674227
End Sub

Private Sub Return_Click()
FormGuassF.Hide
End Sub


Private Sub Text_B1_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
      Case Asc("-") '允许负数
            If Text_B1.SelStart = 0 Then
              If Left(Text_B1.Text, 1) = "-" Then
                  KeyAscii = 0
                  Beep
              End If
            Else
              KeyAscii = 0
              Beep
            End If
        Case 8
              '无变化,退格键不屏蔽
        Case Asc(" ") '32
            If Text_B1.SelLength = 0 Then
                KeyAscii = 0
            End If
        Case Asc(".") '46 '允许小数点
            If InStr(Text_B1.Text, ".") Then
                KeyAscii = 0
            End If
        Case Is < Asc(0) '48
              KeyAscii = 0
        Case Is > Asc(9) '57
              KeyAscii = 0
  End Select
End Sub

Private Sub Text_B2_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
      Case Asc("-") '允许负数
            If Text_B2.SelStart = 0 Then
              If Left(Text_B2.Text, 1) = "-" Then
                  KeyAscii = 0
                  Beep
              End If
            Else
              KeyAscii = 0
              Beep
            End If
        Case 8
              '无变化,退格键不屏蔽
        Case Asc(" ") '32
            If Text_B2.SelLength = 0 Then
                KeyAscii = 0
            End If
        Case Asc(".") '46 '允许小数点
            If InStr(Text_B2.Text, ".") Then
                KeyAscii = 0
            End If
        Case Is < Asc(0) '48
              KeyAscii = 0
        Case Is > Asc(9) '57
              KeyAscii = 0
  End Select
End Sub

Private Sub Text_L1_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
      Case Asc("-") '允许负数
            If Text_L1.SelStart = 0 Then
              If Left(Text_L1.Text, 1) = "-" Then
                  KeyAscii = 0
                  Beep
              End If
            Else
              KeyAscii = 0
              Beep
            End If
        Case 8
              '无变化,退格键不屏蔽
        Case Asc(" ") '32
            If Text_L1.SelLength = 0 Then
                KeyAscii = 0
            End If
        Case Asc(".") '46 '允许小数点
            If InStr(Text_L1.Text, ".") Then
                KeyAscii = 0
            End If
        Case Is < Asc(0) '48
              KeyAscii = 0
        Case Is > Asc(9) '57
              KeyAscii = 0
  End Select
End Sub
Private Sub Text_L2_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
      Case Asc("-") '允许负数
            If Text_L2.SelStart = 0 Then
              If Left(Text_L2.Text, 1) = "-" Then
                  KeyAscii = 0
                  Beep
              End If
            Else
              KeyAscii = 0
              Beep
            End If
        Case 8
              '无变化,退格键不屏蔽
        Case Asc(" ") '32
            If Text_L2.SelLength = 0 Then
                KeyAscii = 0
            End If
        Case Asc(".") '46 '允许小数点
            If InStr(Text_L2.Text, ".") Then
                KeyAscii = 0
            End If
        Case Is < Asc(0) '48
              KeyAscii = 0
        Case Is > Asc(9) '57
              KeyAscii = 0
  End Select
End Sub