hanshuji1.bas

用于公路、轻轨及铁路双线线间距工程计算的源程序。

Attribute VB_Name = "hanshuji1"
Option Explicit
Dim pi As Double

'度分秒→度函数(2)
Public Function dmsdeg2(angle As Double) As Double
 Dim n As Integer
 Dim strAngle1 As String
 Dim strDD As String
 Dim strMM As String
 Dim strSS As String
  strAngle1 = Trim(Str(angle))
  n = InStr(strAngle1, ".")
 If n = 0 Then
  dmsdeg2 = angle
 Else
  strDD = Mid(strAngle1, 1, n - 1)
  strMM = Mid(strAngle1, n + 1, 2)
  strSS = Mid(strAngle1, n + 3, 2) & "." & Mid(strAngle1, n + 5)
If angle > 0 Then
   dmsdeg2 = Val(strDD) + Val(strMM) / 60 + Val(strSS) / 3600
Else
 dmsdeg2 = Val(strDD) - Val(strMM) / 60 - Val(strSS) / 3600
End If
End If
End Function

'度→度分秒函数(2)
Public Function degdms2(angle As Double) As Double
  Dim n As Integer
  Dim strAngle1 As String
  Dim strDD As String
  Dim strMM As String
  Dim strSS As String
  strAngle1 = Trim(Str(angle))
  n = InStr(strAngle1, ".")
 If n = 0 Then
  degdms2 = angle
 Else
  strDD = Mid(strAngle1, 1, n - 1)
  strMM = Str(Fix(Val(Mid(strAngle1, n)) * 60))
  If Val(strMM) < 10 Then strMM = "0" & strMM
  strSS = Str(CInt((Val(Mid(strAngle1, n)) - Val(strMM) / 60) * 3600))
  If Val(strSS) < 10 Then strSS = "0" & strSS
  degdms2 = Val(strDD & "." & strMM & strSS)
 End If
End Function
'度→度分秒函数(1)
Public Function degdms1(angle As Double) As Double
Dim sss As Double
Dim dd As Single
Dim mm As Single
Dim ss As Double
sss = angle * 3600
ss = (sss Mod 60) / 10000
mm = ((sss \ 60) Mod 60) / 100
dd = (sss \ 60) \ 60
degdms1 = dd + mm + ss
End Function
'度→度分秒函数
Public Function degdms(angle As Double) As Double
Dim dd As Single
Dim mm As Single
Dim ss As Double
Dim aaa As Double
dd = Fix(angle)
aaa = (angle - dd) * 60
mm = Fix(aaa) / 100
ss = (angle - dd - mm / 0.6) * 3600 / 10000
degdms = dd + mm + ss
End Function
'度分秒→度函数
Public Function dmsdeg(angle As Double) As Double
Dim aaa As Double
aaa = angle * 100
dmsdeg = (aaa - Fix(aaa)) * 100 / 3600 + _
         (Fix(aaa) - Fix(angle) * 100) / 60 + _
          Fix(angle)
End Function
'弧度→度函数
Public Function raddeg(angle As Double) As Double
pi = 4 * Atn(1)
raddeg = angle * 180 / pi
End Function
'度→弧度函数
Public Function degrad(angle As Double) As Double
pi = 4 * Atn(1)
degrad = angle * pi / 180
End Function
'度分秒→弧度函数
Public Function dmsrad(angle As Double) As Double
Dim deg As Double
Dim aaa As Double
pi = 4 * Atn(1)
aaa = angle * 100
deg = (aaa - Fix(aaa)) * 100 / 3600 + _
      (Fix(aaa) - Fix(angle) * 100) / 60 + _
       Fix(angle)
dmsrad = deg * pi / 180
End Function
'弧度→度分秒函数
Public Function raddms(angle As Double) As Double
Dim deg As Double
Dim dd As Single
Dim mm As Single
Dim ss As Double
Dim aaa As Double
pi = 4 * Atn(1)
deg = angle * 180 / pi
dd = Fix(deg)
aaa = (deg - dd) * 60
mm = Fix(aaa) / 100
ss = (deg - dd - mm / 0.6) * 3600 / 10000
raddms = dd + mm + ss
End Function