P2 = C * 3600 + D * 60 + E P3 = 180# * 3600#
P4 = M * 3600 + N * 60 + L
If (P4 = 0) Then Z = P2 Else
Z = P2 + P4 + P3 End If
S = 360# * 3600# If (Z > (2 * S)) Then T = Z - (2 * S) ElseIf (Z > S) Then T = Z - S Else T = Z End If
T3 = 648000
Q1 = T3 / P1 ' 一弧度是多少秒 G = (P1 / P3) * T H = A + F * Cos(G) P = B + F * Sin(G) A1 = NNN(H, 3) B1 = NNN(P, 3) TTAN = G * Q1
TTAND = Fix(TTAN / 3600) '求取度数
TTANF = Fix((TTAN / 3600 - TTAND) * 60) '求取分数
TTANM = (((TTAN / 3600) - TTAND) * 60 - TTANF) * 60 '求取秒值 T6 = NNN(TTANM, 0) If (T6 = 60) Then T6 = 0
TTANF = TTANF + 1 End If
If (TTANF = 60) Then TTANF = 0
TTAND = TTAND + 1 End If
Text8.Text = Str(A1) '此处输出求得的坐标x Text9.Text = Str(B1) '此处输出求得的坐标y Text10.Text = TTAND Text11.Text = TTANF Text12.Text = T6
End Sub
Private Function NNN(E As Double, F As Integer) As Double
Dim M As Integer: '***保存符号*** Dim N As Double Dim Q As Double Dim K As Integer Dim S As Integer
M = Sgn(E): '***保存符号*** N = Abs(E): '***取绝对值***
Q = Fix(N * 10 ^ (F + 1)) - 10 * Fix(N * 10 ^ F): '***要保留位数的后一位***
S = Fix(N * 10 ^ F) - 10 * Fix(N * 10 ^ (F - 1)): '***所要保留的数的最后一位*** If Q > 5 Then K = 1
ElseIf Q < 5 Then K = 0
ElseIf (Q = 5 And S = 2 * Fix(S / 2)) Then K = 0 Else K = 1 End If
NNN = M * (Fix(N * 10 ^ F + K) / 10 ^ F) End Function
6
坐标反算程序部分源代码如下： ????????????
Private Function TTAB(ByVal DX12 As
Double, ByVal DY12 As Double) As Double Rem ***** 坐标反算函数 *****
Dim I As Integer I = 10
If DX12 = 0 And DY12 = 0 Then '***** 1、2为同一点，TTAB无意义，应返回-1值 I = 0
ElseIf DX12 > 0 And DY12 = 0 Then '***** 1、2两点依次位于正向的纵轴上，TTAB=0° I = 1
ElseIf DX12 > 0 And DY12 > 0 Then '***** TTAB位于第一象限 I = 2
ElseIf DX12 = 0 And DY12 > 0 Then '***** 1、2两点依次位于正向的横轴上，TTAB=90° I = 3
ElseIf DX12 < 0 And DY12 > 0 Then '***** TTAB位于第二象限 I = 4
ElseIf DX12 < 0 And DY12 = 0 Then '***** 1、2两点依次位于负向的纵轴上，TTAB=180° I = 5
ElseIf DX12 < 0 And DY12 < 0 Then '***** TTAB位于第三象限 I = 6
ElseIf DX12 = 0 And DY12 < 0 Then '*****1、2两点依次位于负向的横轴上，TTAB=270° I = 7
ElseIf DX12 > 0 And DY12 < 0 Then '***** TTAB位于第四象限 I = 8
Else '***** 当输入数据含有非数字的字符时，TTAB无意义，应返回-1值 I = 10 End If
Select Case I Case 0
TTAB = -1 Case 1
TTAB = 0 Case 2
TTAB = Atn(DY12 / DX12) Case 3
TTAB = PI() / 2 Case 4
TTAB = PI() + Atn(DY12 / DX12) Case 5
TTAB = PI() Case 6
TTAB = PI() + Atn(DY12 / DX12) Case 7
TTAB = 3 * PI() / 2 Case 8
TTAB = 2 * PI() + Atn(DY12 / DX12) Case 9
TTAB = -1 End Select
End Function
??????????????
7
（5）其他程序源代码见下图：
8