请选择 进入手机版 | 继续访问电脑版
设为首页收藏本站

共享社区

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

搜索
热搜: 活动 交友 discuz
查看: 750|回复: 4

[分享] 分享一个关于余弦反余弦算法的程序

[复制链接]

82

主题

113

帖子

184

积分

信息监察员

Rank: 9Rank: 9Rank: 9

威望
1
金钱
356
贡献
2
发表于 2015-10-28 15:46:11 | 显示全部楼层 |阅读模式
代码如下:
Private Sub Command1_Click()
Dim A As Single: Dim B1 As Single: Dim B2 As Single: Dim C As Single: Dim X As Single
Dim H As Single: Dim M As Single: Dim S As Single
If Val(T1H1.Text) < 0 Then
A = Val(T1H1.Text) - Val(T1M1.Text) / 60 - Val(T1S1.Text) / 3600
Else
A = Val(T1H1.Text) + Val(T1M1.Text) / 60 + Val(T1S1.Text) / 3600
End If
If Val(T1H2.Text) < 0 Then
B1 = Val(T1H2.Text) - Val(T1M2.Text) / 60 - Val(T1S2.Text) / 3600
Else
B1 = Val(T1H2.Text) + Val(T1M2.Text) / 60 + Val(T1S2.Text) / 3600
End If
If Val(T1H3.Text) < 0 Then
B2 = Val(T1H3.Text) - Val(T1M3.Text) / 60 - Val(T1S3.Text) / 3600
Else
B2 = Val(T1H3.Text) + Val(T1M3.Text) / 60 + Val(T1S3.Text) / 3600
End If
If B1 * B2 > 0 Then
  X = Cos(A / 180 * 3.1415926) * Cos(B1 / 180 * 3.1415926) * Cos(B2 / 180 * 3.1415926) + _
      Sin(B1 / 180 * 3.1415926) * Sin(B2 / 180 * 3.1415926)
Else
  X = Cos(A / 180 * 3.1415926) * Cos(B1 / 180 * 3.1415926) * Cos(B2 / 180 * 3.1415926) + _
      Sin(B1 / 180 * 3.1415926) * Sin(B2 / 180 * 3.1415926)
End If
If X >= -1 And X < -0.5 Then
  C = Atn(Sqr(1 - X * X) / X) + 4 * Atn(1)
ElseIf X <= 0.5 Then
  C = -Atn(X / Sqr(1 - X * X)) + 2 * Atn(1)
ElseIf X <= 1 Then
  C = Atn(Sqr(1 - X * X) / X)
End If
  C = C / 3.1415926 * 180
If C > 0 Then
H = Int(C): M = Int((C - H) * 60): S = Int((C - H - M / 60) * 3600)
ElseIf C = 0 Then
H = 0: M = 0: S = 0
Else
H = Fix(C): M = Int((C - H) * (-1) * 60): S = Int((C - H + M / 60) * (-1) * 3600)
End If
T1H.Text = H: T1M.Text = M: T1S.Text = S
End Sub

Private Sub Command2_Click()
Dim A As Single: Dim B As Single: Dim C As Single: Dim X As Single
Dim H As Single: Dim M As Single: Dim S As Single
If Val(T2H1.Text) < 0 Then
A = Val(T2H1.Text) - Val(T2M1.Text) / 60 - Val(T2S1.Text) / 3600
Else
A = Val(T2H1.Text) + Val(T2M1.Text) / 60 + Val(T2S1.Text) / 3600
End If
If Val(T2H2.Text) < 0 Then
B = Val(T2H2.Text) - Val(T2M2.Text) / 60 - Val(T2S2.Text) / 3600
Else
B = Val(T2H2.Text) + Val(T2M2.Text) / 60 + Val(T2S2.Text) / 3600
End If
X = Cos(A / 180 * 3.1415926) * Cos(B / 180 * 3.1415926)
If X >= -1 And X < -0.5 Then
  C = Atn(Sqr(1 - X * X) / X) + 4 * Atn(1)
ElseIf X <= 0.5 Then
  C = -Atn(X / Sqr(1 - X * X)) + 2 * Atn(1)
ElseIf X <= 1 Then
  C = Atn(Sqr(1 - X * X) / X)
End If
  C = C / 3.1415926 * 180
If C > 0 Then
H = Int(C): M = Int((C - H) * 60): S = Int((C - H - M / 60) * 3600)
ElseIf C = 0 Then
H = 0: M = 0: S = 0
Else
H = Fix(C): M = Int((C - H) * (-1) * 60): S = Int((C - H + M / 60) * (-1) * 3600)
End If
T2H.Text = H: T2M.Text = M: T2S.Text = S

End Sub

Private Sub Command3_Click()
T1H1 = "": T1H2 = "": T1H3 = ""
T1M1 = "": T1M2 = "": T1M3 = ""
T1S1 = "": T1S2 = "": T1S3 = ""
T2H1 = "": T2H2 = "": T2M1 = "": T2M2 = "": T2S1 = "": T2S2 = ""
T1H = "": T1M = "": T1S = "": T2H = "": T2M = "": T2S = ""
End Sub

求高手斧正。
jdfw.gif

工程1.exe

304 KB, 下载次数: 0

回复

使用道具 举报

82

主题

113

帖子

184

积分

信息监察员

Rank: 9Rank: 9Rank: 9

威望
1
金钱
356
贡献
2
 楼主| 发表于 2015-10-28 15:49:24 | 显示全部楼层
回复 支持 反对

使用道具 举报

14

主题

84

帖子

152

积分

网站编辑

Rank: 8Rank: 8

威望
0
金钱
251
贡献
6
发表于 2015-10-28 16:41:03 | 显示全部楼层
赞一个!
回复

使用道具 举报

12

主题

59

帖子

188

积分

排长

Rank: 2

威望
4
金钱
294
贡献
5
发表于 2015-10-29 08:20:18 | 显示全部楼层
学习了太长看不懂哈哈
回复 支持 反对

使用道具 举报

39

主题

125

帖子

142

积分

排长

Rank: 2

威望
0
金钱
253
贡献
0
发表于 2015-11-24 01:25:52 | 显示全部楼层
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

小黑屋|手机版|Archiver|共享社区 ( 京ICP备15025663号-2  

GMT+8, 2018-12-11 08:26 , Processed in 0.171894 second(s), 26 queries .

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表