Dim jd(1 To 500) As Double
Dim ds(1 To 500) As Double
Dim n As Integer
Dim jdh As Double
Dim gzj(1 To 500) As String
Dim fwj As Double
Dim zbfwj(0 To 500) As Double
Dim zbfwj1(0 To 500) As String
Dim dx(1 To 500) As Single, dy(1 To 500) As Single
Dim x(1 To 500) As Single, y(1 To 500) As Single
Public Function Deg2Rad(a As Double) As Double
Dim Ra As Double
Dim c As Double
Dim d As Double
Dim e As Long
Dim f As Long
Ra = pi / 180
e = Int(a)
c = (a - e) * 100
f = Int(c)
d = (c - f) * 100
Deg2Rad = (e + f / 60 + d / 3600) * Ra
End Function
Public Function Degree(a As Double) As Double
Dim b As Double
Dim Fs1 As Double
Dim Im1 As Integer
Dim Id1 As Integer
b = a
Call DMS(b, Id1, Im1, Fs1)
Degree = Id1 + Im1 / 100# + Fs1 / 10000#
End Function
Public Sub DMS(a As Double, ID As Integer, IM As Integer, FS As Double)
Dim b As Double
Dim c As Double
c = a
c = 180# / pi * c
ID = Int(c + 0.0000005)
b = (c - ID) * 60 + 0.0005
IM = Int(b)
FS = (b - IM) * 60
End Sub
Public Function Deg2DMS(b As Double) As String
Dim a As Double
Dim ad As Single
Dim d As Single
Dim ag As Single
Dim e As Single
Dim ah As Single
a = b + 0.00005
ad = Format(Fix(a))
d = a - ad
ag = Format(Fix(d * 100))
e = d * 100 - ag
ah = Int(e * 100)
Deg2DMS = ad & "°" & ag & "′" & ah & "〃"
End Function
Private Sub Command1_Click()
CommonDialog1.Filter = "所有文件 (*.*)|*.*"
CommonDialog1.FilterIndex = 1
CommonDialog1.InitDir = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "數據"
CommonDialog1.Action = 1
Open CommonDialog1.FileName For Input As #1
i = 0: j = 0
Do While Not EOF(1)
i = i + 1
Input #1, jd(i)
gzj(i) = Deg2DMS(jd(i))
Text4.Text = Text4.Text & gzj(i) & vbCrLf
Loop
Close #1
n = i
End Sub
Private Sub Command4_Click()
Dim yz As String
CommonDialog1.Filter = "所有文件 (*.*)|*.*"
CommonDialog1.FilterIndex = 1
CommonDialog1.InitDir = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "數據"
CommonDialog1.Action = 1
Open CommonDialog1.FileName For Input As #1
Input #1, fwj
yz = Deg2DMS(fwj)
Text1.Text = Text1.Text & yz & vbCrLf
End Sub
Private Sub Command3_Click()
CommonDialog1.Filter = "所有文件 (*.*)|*.*"
CommonDialog1.FilterIndex = 1
CommonDialog1.InitDir = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "數據"
CommonDialog1.Action = 1
Open CommonDialog1.FileName For Input As #1
i = 0: j = 0
Do While Not EOF(1)
i = i + 1
Input #1, ds(i)
Text7.Text = Text7.Text & ds(i) & vbCrLf
Loop
Close #1
n = i
End Sub
Private Sub Command2_Click()
Dim af As Double, ad As String, ag As Integer, gzs As Double, dsh As Single, wd As Double
Dim dyh As Single, dxh As Single
Dim y1 As Single, x1 As Single
Dim jd1(1 To 500) As Double
For i = 1 To n
jd(i) = Deg2Rad(jd(i))
Next
For i = 1 To n
jdh = jdh + jd(i)
Next
af = Degree(jdh - pi * (n - 2))
ad = Deg2DMS(af)
Text9.Text = ad
gzs = (jdh - pi * (n - 2)) / n
For i = 1 To n
jd(i) = jd(i) - gzs
jd1(i) = Degree(jd(i))
gzj(i) = Deg2DMS(jd1(i))
Text5.Text = Text5.Text & gzj(i) & vbCrLf
Next
fwj = Deg2Rad(fwj)
zbfwj(0) = fwj
For i = 1 To n
zbfwj(i) = zbfwj(i - 1) + jd(i)
If zbfwj(i) >= 2 * pi Then
zbfwj(i) = zbfwj(i) - 2 * pi
End If
If zbfwj(i) >= pi Then
zbfwj(i) = zbfwj(i) - pi
ElseIf zbfwj(i) < pi Then
zbfwj(i) = zbfwj(i) + pi
End If
Next
For i = 1 To n
zbfwj(i) = Degree(zbfwj(i))
zbfwj1(i) = Deg2DMS(zbfwj(i))
Text6.Text = Text6.Text & zbfwj1(i) & vbCrLf
Next
For i = 1 To n
zbfwj(i) = Deg2Rad(zbfwj(i))
Next
dx(1) = Cos(zbfwj(0)) * ds(1)
dy(1) = Sin(zbfwj(0)) * ds(1)
For i = 2 To n
dx(i) = Cos(zbfwj(i - 1)) * ds(i)
dy(i) = Sin(zbfwj(i - 1)) * ds(i)
Next
For i = 1 To n
dxh = dxh + dx(i)
dyh = dyh + dy(i)
Next
For i = 1 To n
dsh = dsh + ds(i)
Next
For i = 1 To n
dx(i) = dx(i) - dxh * ds(i) / dsh
dy(i) = dy(i) - dyh * ds(i) / dsh
Next
x1 = Val(Text2.Text)
y1 = Val(Text3.Text)
x(1) = x1 + dx(1)
y(1) = y1 + dy(1)
For i = 2 To n
x(i) = x(i - 1) + dx(i)
y(i) = y(i - 1) + dy(i)
Next
For i = 1 To n
Text8.Text = Text8.Text & x(i) & vbCrLf
Text10.Text = Text10.Text & y(i) & vbCrLf
Next
wd = (Sqr((dxh) * (dxh) + (dyh) * (dyh))) / dsh
wd = Int(1 / wd)
Text11.Text = "fx=" & Int(dxh * 10000 + 0.5) / 10000 & " " & "fy=" & Int(dyh * 10000 + 0.5) / 10000 & " " & "WD=1/" & wd
End Sub
Private Sub Command5_Click()
Unload Form2
Dim nForm As New Form2
Form2.Show
End Sub
Private Sub Command6_Click()
Form3.Show
Form2.Hide
End Sub