VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClsMath"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False


Option Explicit
Public Error As Boolean
Const Eps = 0.00000001
Function SinD(ByVal x As Double) As Double
On Error GoTo errr
'X = FctINput * X
SinD = Sin(x * ra)
Exit Function
errr:  Error = True
End Function

Function CosD(ByVal x As Double) As Double
On Error GoTo errr
'X = FctINput * X
CosD = Cos(x * ra)
Exit Function
errr:  Error = True
End Function
Function TanD(ByVal x As Double) As Double
On Error GoTo errr
'X = FctINput * X
TanD = Tan(x * ra)
Exit Function
errr:  Error = True
End Function
Function Cot(ByVal x As Double) As Double
On Error GoTo errr
'X = FctINput * X
Cot = 1 / Tan(x)
Exit Function
errr:  Error = True
End Function
Function CotD(ByVal x As Double) As Double
On Error GoTo errr
'X = FctINput * X
CotD = 1 / Tan(x * ra)
Exit Function
errr:  Error = True
End Function
Function Csc(ByVal x As Double) As Double
On Error GoTo errr
'X = FctINput * X
Csc = 1 / Sin(x)
Exit Function
errr:  Error = True
End Function
Function CscD(ByVal x As Double) As Double
On Error GoTo errr
'X = FctINput * X
CscD = 1 / Sin(x * ra)
Exit Function
errr:  Error = True
End Function
Function Sec(ByVal x As Double) As Double
On Error GoTo errr
'X = FctINput * X
Sec = 1 / Cos(x)
Exit Function
errr:  Error = True
End Function
Function SecD(ByVal x As Double) As Double
On Error GoTo errr
'X = FctINput * X
SecD = 1 / Cos(x * ra)
Exit Function
errr:  Error = True
End Function
Function Asin(ByVal x As Double) As Double
If (Abs(x) - 1) <= Eps Then
Asin = (x / Abs(x) * PI / 2#)
'FrmEngCal.Option2(1).Visible = True
Exit Function
 End If
On Error GoTo errr
Asin = Atn(x / Sqr(-x * x + 1))
'FrmEngCal.Option2(1).Visible = True
Exit Function
errr:  Error = True
End Function
Function AsinD(ByVal x As Double) As Double
AsinD = Asin(x) * Da
End Function
Function Acos(ByVal x As Double) As Double
If (Abs(x) - 1) <= Eps Then
If x > 0# Then Acos = 0#
If x < 0# Then Acos = PI
'FrmEngCal.Option2(1).Visible = True
Exit Function
End If
On Error GoTo errr
Acos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
'FrmEngCal.Option2(1) = True
Exit Function
errr:  Error = True
End Function
Function AcosD(ByVal x As Double) As Double
AcosD = Acos(x) * Da
End Function
Function Asec(ByVal x As Double) As Double
On Error GoTo errr
Asec = Atn(x / Sqr(x * x - 1)) + Sgn((x) - 1) * (2 * Atn(1))
Exit Function
errr:  Error = True
End Function
Function AsecD(ByVal x As Double) As Double
AsecD = Asec(x) * Da
End Function
Function Acsc(ByVal x As Double) As Double
On Error GoTo errr
Acsc = Atn(x / Sqr(x * x - 1)) + (Sgn(x) - 1) * (2 * Atn(1))
Exit Function
errr:  Error = True
End Function
Function AcscD(ByVal x As Double) As Double
AcscD = Acsc(x) * Da
End Function
Function Acot(ByVal x As Double) As Double:
Acot = Atn(x) + 2 * Atn(1)
End Function
Function AcotD(ByVal x As Double) As Double:
AcotD = Acot(x) * Da
End Function
Function Atan(ByVal x As Double) As Double:
Atan = Atn(x)
End Function
Function AtanD(ByVal x As Double) As Double:
AtanD = Atan(x) * Da

End Function

Function sinH(ByVal x As Double) As Double
On Error GoTo errr
sinH = (Exp(x) - Exp(-x)) / 2
Exit Function
errr:  Error = True
End Function
Function cosH(ByVal x As Double) As Double
On Error GoTo errr
cosH = (Exp(x) + Exp(-x)) / 2
Exit Function
errr:  Error = True
End Function
Function tanH(ByVal x As Double) As Double
On Error GoTo errr
tanH = (Exp(x) - Exp(-x)) / (Exp(x) + Exp(-x))
Exit Function
errr:  Error = True
End Function
Function secH(ByVal x As Double) As Double
On Error GoTo errr
secH = 2 / (Exp(x) + Exp(-x))
Exit Function
errr:  Error = True
End Function
Function cscH(ByVal x As Double) As Double
On Error GoTo errr
cscH = 2 / (Exp(x) - Exp(-x))
Exit Function
errr:  Error = True
End Function
Function cotH(ByVal x As Double) As Double
On Error GoTo errr
cotH = (Exp(x) + Exp(-x)) / (Exp(x) - Exp(-x))
Exit Function
errr:  Error = True
End Function
Function AsinH(ByVal x As Double) As Double
On Error GoTo errr
AsinH = Log(x + Sqr(x * x + 1))
Exit Function
errr:  Error = True
End Function
Function ACosH(ByVal x As Double) As Double
On Error GoTo errr
ACosH = Log(x + Sqr(x * x - 1))
Exit Function
errr:  Error = True
End Function
Function AtanH(ByVal x As Double) As Double
On Error GoTo errr
AtanH = Log((1 + x) / (1 - x)) / 2#
Exit Function
errr:  Error = True
End Function
Function AsecH(ByVal x As Double) As Double
On Error GoTo errr
AsecH = Log((Sqr(-x * x + 1) + 1) / x)
Exit Function
errr:  Error = True
End Function
Function AcscH(ByVal x As Double) As Double
On Error GoTo errr
AcscH = Log((Sgn(x) * Sqr(x * x + 1) + 1) / x)
Exit Function
errr:  Error = True
End Function
Function AcotH(ByVal x As Double) As Double
On Error GoTo errr
AcotH = Log((x + 1) / (x - 1)) / 2
Exit Function
errr:  Error = True
End Function
Function e() As Double
e = 2.71828182845904
End Function
Function PI() As Double
PI = 3.14159265358979
End Function
Function ra()
ra = PI / 180#
End Function
Function Da()
Da = 180# / PI
End Function
Function Frac(ByVal x As Double) As Double
Frac = x - Int(x)
End Function
Function LogN(ByVal R As Double, ByVal B As Double) As Double
On Error GoTo errr
LogN = Log(B) / Log(R)
Exit Function
errr:  Error = True
End Function
Function Log10(ByVal x As Double, Optional HasCondition As Boolean = False) As Double
On Error GoTo errr
Log10 = Log(x) / Log(10)
Exit Function
errr:  Error = True
If HasCondition = True Then Log10 = 0#
End Function
Function Ln(ByVal x As Double) As Double
On Error GoTo errr
Ln = Log(x)
Exit Function
errr:  Error = True
End Function

Public Function RadFromDms(ByVal St1 As String) As Double
Dim St2 As String, St3 As String, stResult() As String
Dim deg As Double, MIN As Double, Sec As Double, TPT As Double
Dim Ll As Integer, result As Integer, icase As Integer
St1 = LCase(St1)   '將大寫英文改為小寫
result = InStr(St1, "d")   '輸入形式為:36d56m34s
If result <> 0 Then
icase = 1
GoTo 50
End If
result = InStr(St1, "°")    '輸入形式為:36°56'34''
If result <> 0 Then
icase = 2
GoTo 50
End If
result = InStr(St1, "度")   '輸入形式為:36度56分34秒
If result <> 0 Then
icase = 3
GoTo 50
End If
50 Select Case icase
Case 1
stResult = Split(St1, "d", -1, vbTextCompare)  '分解資料為36及56m34s
Ll = LBound(stResult)
deg = CDbl(Val(stResult(Ll)))  '取得度數為36
St2 = stResult(Ll + 1)         '取得剩餘資料為56m34s
stResult = Split(St2, "m", -1, vbTextCompare) '分解資料為56及34s
Ll = LBound(stResult)
MIN = CDbl(Val(stResult(Ll))) '取得分數為56
St3 = stResult(Ll + 1)        '取得剩餘資料為34s
stResult = Split(St2, "s", -1, vbTextCompare) '分解資料為34
Ll = LBound(stResult)
Sec = CDbl(Val(stResult(Ll))) '取得秒數為34
Case 2
stResult = Split(St1, "°", -1, vbTextCompare) '分解資料為36及56'34''
Ll = LBound(stResult)
deg = CDbl(Val(stResult(Ll)))
St2 = stResult(Ll + 1)
stResult = Split(St2, "'", -1, vbTextCompare)
Ll = LBound(stResult)
MIN = CDbl(Val(stResult(Ll)))
St3 = stResult(Ll + 1)
stResult = Split(St2, "''", -1, vbTextCompare) '注意此處之秒由兩個'組成一個"
Ll = LBound(stResult)
Sec = CDbl(Val(stResult(Ll)))
Case 3
stResult = Split(St1, "度", -1, vbTextCompare)
Ll = LBound(stResult)
deg = CDbl(Val(stResult(Ll)))
St2 = stResult(Ll + 1)
stResult = Split(St2, "分", -1, vbTextCompare)
Ll = LBound(stResult)
MIN = CDbl(Val(stResult(Ll)))
St3 = stResult(Ll + 1)
stResult = Split(St2, "秒", -1, vbTextCompare)
Ll = LBound(stResult)
Sec = CDbl(Val(stResult(Ll)))
End Select
TPT = CDbl(deg + MIN / 60 + Sec / 60 / 60)
RadFromDms = TPT * ra
End Function
Public Function DmsFromRad(ByVal rad As Double, Optional Itype As Integer = 1) As String
Dim tpt1 As Double, tpt2 As Double, tpt3 As Double
Dim ideg As Integer, IMIN As Integer, Sec As Single
tpt1 = rad * Da
ideg = Fix(tpt1)   '取整數
tpt2 = (tpt1 - ideg)  '不足1度之分數部份
tpt3 = tpt2 * 60 '換算成分
IMIN = Fix(tpt3)
Sec = (tpt3 - IMIN) * 60 '換算成秒
If Sec >= 60# Then  '超過60秒時進位
Sec = Sec - 60#
IMIN = IMIN + 1
End If
If IMIN >= 60# Then
IMIN = IMIN - 60    '超過60分時進位
ideg = ideg + 1
End If
Select Case Itype
Case 1
DmsFromRad = ideg & "d" & IMIN & "m" & Sec & "s" '輸出為:d_m_s"
Case 2
DmsFromRad = ideg & "度" & IMIN & "分" & Sec & "秒" '輸出為:度_分_秒
Case 3
DmsFromRad = ideg & "°" & IMIN & "'" & Sec & "''" '輸出為:°_'_''
End Select
End Function

' 1. 正弦sind（度分秒）
Public Function SinS(ByVal x As String) As Double
SinS = Sin(RadFromDms(x))
End Function
 
' 2. 餘弦cosd（度分秒）
Public Function CosS(ByVal x As String) As Double
CosS = Cos(RadFromDms(x))
End Function
 
' 3. 正切tand（度分秒）
Public Function TanS(ByVal x As String) As Double
TanS = Tan(RadFromDms(x))
End Function
 
' 4. 餘切ctnd（度分秒）
Public Function CtnS(ByVal x As String) As Double
CtnS = 1 / Tan(RadFromDms(x) + 0.00000000000001)
End Function
 
' 6. 反正弦→（度分秒）
Public Function AsinToDms(ByVal x As Double) As String
AsinToDms = DmsFromRad(Atn(x / Sqr(1 - x * x)))
End Function
 

 
' 8. 反餘弦→（度分秒）
Public Function AcosToDms(ByVal x As Double) As String
AcosToDms = DmsFromRad(Atn(-x / Sqr(1 - x * x)) + 2 * Atn(1))
End Function
 
' 9. 反正切→（度分秒）
Public Function AtnToDms(ByVal x As Double) As String
AtnToDms = DmsFromRad(Atn(x))
End Function
'10  sign
Public Function SIGN(ByVal x As Double) As Integer
Select Case x
Case x = 0
SIGN = 0
Case Else
SIGN = x / Abs(x)
End Select
End Function
'11 mod
Public Function Modxy(ByVal x As Double, y As Double) As Double
Modxy = x Mod y
End Function

 Public Function Floor(ByVal number) As Long
    Floor = Fix(number)
 End Function
Public Function Lcm(ByVal M As Long, ByVal n As Long) As Long
Dim k As Long, i As Long
If M <= 0 Or n < 0 Or Int(M) <> M Or Int(n) <> n Then MsgBox ("Err input data")
k = M
If M > n Then k = n
For i = k To 1 Step -1
If M / i = Int(M / i) And n / i = Int(n / i) Then GoTo 90
Next i
90 Lcm = M * n / i
End Function

Public Function Gcd(ByVal M As Long, ByVal n As Long) As Long
Dim k As Long, i As Long
If M <= 0 Or n < 0 Or Int(M) <> M Or Int(n) <> n Then MsgBox ("Err input data")
k = M
If M > n Then k = n
For i = k To 1 Step -1
If M / i = Int(M / i) And n / i = Int(n / i) Then GoTo 90
Next i

90 Gcd = i
End Function
Public Function Odd(ByVal number) As Long
Dim I1 As Long, I2 As Long, isOdd As Boolean, isInteger As Boolean
Dim SIGN As Integer
SIGN = Sgn(number)
I1 = Fix(number)
'MsgBox ("i1= " & i1)
I2 = I1 Mod 2
If I2 = 0 Then
isOdd = False
Else
isOdd = True
End If
If I1 = number Then
isInteger = True
Else
isInteger = False
End If
'case number=0
If number = 0 And I1 = number Then
Odd = 1
Exit Function
End If
'case isinteger=true  & isodd=true
If isInteger = True And isOdd = True Then
Odd = number
Exit Function
End If
If isInteger = True And isOdd = False Then
Odd = number + 1 * SIGN
Exit Function
End If
If Abs(number) > Abs(I1) And isOdd = True Then
Odd = I1 + 2 * SIGN
Exit Function
End If
If Abs(number) > Abs(I1) And isOdd = False Then
Odd = I1 + 1 * SIGN
Exit Function
End If
End Function
Public Function Even(ByVal number) As Long
Dim I1 As Long, I2 As Long, isEven As Boolean, isInteger As Boolean
Dim SIGN As Integer
SIGN = Sgn(number)
I1 = Fix(number)
'MsgBox ("i1= " & i1)
I2 = I1 Mod 2
If I2 = 0 Then
isEven = True
Else
isEven = False
End If
If I1 = number Then
isInteger = True
Else
isInteger = False
End If
'case number=0
If number = 0 And I1 = number Then
Even = 0
Exit Function
End If
'case isinteger=true  & isodd=true
If isInteger = True And isEven = True Then
Even = number
Exit Function
End If
If isInteger = True And isEven = False Then
Even = number + 1 * SIGN
Exit Function
End If
If Abs(number) > Abs(I1) And isEven = True Then
Even = I1 + 2 * SIGN
Exit Function
End If
If Abs(number) > Abs(I1) And isEven = False Then
Even = I1 + 1 * SIGN
Exit Function
End If
End Function


Public Function DMin(ParamArray Vd() As Variant) As Double
'
'
'
    Dim j As Long, J1 As Long, J2 As Long, vDMin As Variant
'
    J1 = LBound(Vd)
    J2 = UBound(Vd)
    vDMin = Vd(J1)
    For j = J1 + 1 To J2
        If vDMin > Vd(j) Then vDMin = Vd(j)
    Next j
'
    DMin = CDbl(vDMin)
'
'
'
End Function
Public Function DMax(ParamArray Vd() As Variant) As Double
'
'
'
    Dim j As Long, J1 As Long, J2 As Long, vDMax As Variant
'
    J1 = LBound(Vd)
    J2 = UBound(Vd)
    vDMax = Vd(J1)
    For j = J1 + 1 To J2
        If vDMax < Vd(j) Then vDMax = Vd(j)
    Next j
'
    DMax = CDbl(vDMax)
'
'
'
End Function
Public Function Sqr2(x As Double) As Double
On Error GoTo errr
If x >= 0# Then
Sqr2 = Sqr(Abs(x))
Else
Sqr2 = -Sqr(Abs(x))
End If
Exit Function
errr:
MsgBox ("error im clsmath.sqr2")

End Function

