www.pudn.com > SuperDLL2.zip > modMath.bas

Attribute VB_Name = "modMath" 
Option Explicit 
 
Public Function Odd(ByVal Num As Variant) As Boolean 
  If (VarType(Num) >= 2) And (VarType(Num) <= 6) Then 
'    Num = Fix(Abs(Num)) 
'    If ((Num / 2) - Fix(Num / 2)) = 0 Then 
'      Odd = False 
'    Else 
'      Odd = True 
'    End If 
    Odd = Fix(Num) Mod 2 <> 0 
  Else 
    MsgBox zNumericStr, vbExclamation, "SuperDLL - Odd" 
  End If 
End Function 
 
Public Function Even(ByVal Num As Variant) As Boolean 
  If (VarType(Num) >= 2) And (VarType(Num) <= 6) Then 
'    Num = Fix(Abs(Num)) 
'    If ((Num / 2) - Fix(Num / 2)) = 0 Then 
'      Even = True 
'    Else 
'      Even = False 
'    End If 
    Even = Fix(Num) Mod 2 = 0 
  Else 
    MsgBox zNumericStr, vbExclamation, "SuperDLL - Even" 
  End If 
End Function 
 
Public Function Earth() As Double 
  Earth = 9.806 
End Function 
 
Public Function Moon() As Double 
  Moon = 2.6 
End Function 
 
Public Function DegToRad(ByVal Deg As Double) As Double 
  DegToRad = (Deg / 180) * PI 
End Function 
 
Public Function RadToDeg(ByVal Rad As Double) As Double 
  RadToDeg = Rad * (180 / PI) 
End Function 
 
Private Function ArcSin(ByVal var1 As Double) As Double 
  ArcSin = Atn(var1 / Sqr(-var1 * var1 + 1)) 
End Function 
 
Public Function CalcVelocity(ByVal Angle As Double, ByVal Range As Double, Optional ByVal Gravity As Double = 9.806, Optional ByVal Quiet As Boolean = False) As Double 
  On Local Error GoTo ErrHnd 
  If (Angle < 0) Or (Angle > 90) Then 
    If Quiet = False Then MsgBox "Angle must be between 0 and 90 !", vbExclamation, "modMath" 
    CalcVelocity = -1 
    Exit Function 
  End If 
  If Range < 0 Then 
    If Quiet = False Then MsgBox "Range must be >= 0 !", vbExclamation, "modMath" 
    CalcVelocity = -1 
    Exit Function 
  End If 
  If ((Angle = 90) And (Range <> 0)) Or ((Angle = 0) And (Range <> 0)) Then 
    If Quiet = False Then MsgBox "IMPOSSIBLE !", vbExclamation, "modMath" 
    CalcVelocity = -1 
    Exit Function 
  End If 
  If (Angle = 0) And (Range = 0) Then 
    CalcVelocity = 0 
  Else 
    CalcVelocity = Sqr((Range * Gravity) / Sin(2 * DegToRad(Angle))) 
  End If 
  Exit Function 
ErrHnd: 
  If Quiet = False Then MsgBox "Impossible to calculate !", vbExclamation, "modMath" 
  CalcVelocity = -1 
End Function 
 
Public Function CalcRange(ByVal Angle As Double, ByVal Velocity As Double, Optional ByVal Gravity As Double = 9.806, Optional ByVal Altitude As Double = 0, Optional ByVal Wind As Double = 0, Optional ByVal Quiet As Boolean = False) As Double 
  On Local Error GoTo ErrHnd 
  Dim VarTmp As Double 
  If (Angle < -90) Or (Angle > 90) Then 
    If Quiet = False Then MsgBox "Angle must be between -90 and 90 !", vbExclamation, "modMath" 
    CalcRange = &H80000000 
    Exit Function 
  End If 
  If Velocity < 0 Then 
    If Quiet = False Then MsgBox "Velocity must be >= 0 !", vbExclamation, "modMath" 
    CalcRange = &H80000000 
    Exit Function 
  End If 
  If ((Angle = 90) And (Wind = 0)) Or ((Altitude <= 0) And (Angle <= 0)) Then 
    CalcRange = 0 
  Else 
    VarTmp = TotalTimeInAir(Angle, Velocity, Gravity, Altitude) 
    If VarTmp <> -1 Then 
      If (Velocity = 0) Or (CalcVeloX(Angle, Velocity) = 0) Then 
        CalcRange = KMHtoMS(Wind) * VarTmp 
      Else 
        CalcRange = (CalcVeloX(Angle, Velocity) * VarTmp) + (((KMHtoMS(Wind) * 5) * VarTmp ^ 2) / CalcVeloX(Angle, Velocity)) 
      End If 
    Else 
      If Quiet = False Then MsgBox "IMPOSSIBLE !", vbExclamation, "modMath" 
      CalcRange = &H80000000 
      Exit Function 
    End If 
'    CalcRange = ((Velocity ^ 2) * Sin(2 * DegToRad(Angle))) / Gravity 
''    CalcRange = (2 * (Velocity ^ 2) * Cos(DegToRad(Angle)) * Sin(DegToRad(Angle))) / Gravity 
''    CalcRange = (2 * CalcVeloX(Angle, Velocity) * CalcVeloY(Angle, Velocity)) / Gravity 
  End If 
  Exit Function 
ErrHnd: 
  If Quiet = False Then MsgBox "Impossible to calculate !", vbExclamation, "modMath" 
  CalcRange = &H80000000 
End Function 
 
Public Function CalcAngle(ByVal Velocity As Double, ByVal Range As Double, Optional ByVal Gravity As Double = 9.806, Optional ByVal Quiet As Boolean = False) As Double 
  On Local Error GoTo ErrHnd 
  If Velocity < 0 Then 
    If Quiet = False Then MsgBox "Velocity must be >= 0 !", vbExclamation, "modMath" 
    CalcAngle = -1 
    Exit Function 
  End If 
  If Range < 0 Then 
    If Quiet = False Then MsgBox "Range must be >= 0 !", vbExclamation, "modMath" 
    CalcAngle = -1 
    Exit Function 
  End If 
  CalcAngle = RadToDeg(ArcSin((Gravity * Range) / (Velocity ^ 2))) / 2 
  Exit Function 
ErrHnd: 
  If Quiet = False Then MsgBox "Impossible to calculate !", vbExclamation, "modMath" 
  CalcAngle = -1 
End Function 
 
Public Function MaxAltitude(ByVal Angle As Double, ByVal Velocity As Double, Optional ByVal Gravity As Double = 9.81, Optional ByVal Altitude As Double = 0) As Double 
  If Angle <= 0 Then 
    MaxAltitude = Altitude 
  Else 
    MaxAltitude = ((CalcVeloY(Angle, Velocity) ^ 2) / (2 * Gravity)) + Altitude 
  End If 
'  MaxAltitude = (Velocity ^ 2 * Sin(DegToRad(Angle)) ^ 2) / (2 * Gravity) 
End Function 
 
Public Function TotalTimeInAir(ByVal Angle As Double, ByVal Velocity As Double, Optional ByVal Gravity As Double = 9.81, Optional ByVal Altitude As Double = 0) As Double 
  On Local Error GoTo ErrHnd 
  TotalTimeInAir = (Sqr((CalcVeloY(Angle, Velocity) ^ 2) + 2 * Gravity * Altitude) + CalcVeloY(Angle, Velocity)) / Gravity 
'  TotalTimeInAir = (2 * CalcVeloY(Angle, Velocity)) / Gravity 
''  TotalTimeInAir = (4 * MaxAltitude(Angle, Velocity, Gravity)) / CalcVeloY(Angle, Velocity) 
''  TotalTimeInAir = (4 / CalcVeloY(Angle, Velocity)) * (CalcVeloY(Angle, Velocity) ^ 2) / (2 * Gravity) 
  Exit Function 
ErrHnd: 
  TotalTimeInAir = -1 
End Function 
 
Public Function KMHtoMS(ByVal KMH As Double) As Double 
  KMHtoMS = KMH / 3.6 
End Function 
 
Public Function MStoKMH(ByVal MS As Double) As Double 
  MStoKMH = MS * 3.6 
End Function 
 
Public Function PI() As Double 
  PI = 3.14159265358979 
End Function 
 
Public Function PI2() As Double 
  PI2 = Atn(1) * 4 
End Function 
 
Public Function CalcVeloX(ByVal Angle As Double, ByVal Velocity As Double) As Double 
  If (Angle = 90) Or (Angle = -90) Then 
    CalcVeloX = 0 
  ElseIf Angle = 0 Then 
    CalcVeloX = Velocity 
  Else 
    CalcVeloX = Velocity * Cos(DegToRad(Angle)) 
  End If 
End Function 
 
Public Function CalcVeloY(ByVal Angle As Double, ByVal Velocity As Double) As Double 
  If Angle = 0 Then 
    CalcVeloY = 0 
  ElseIf (Angle = 90) Or (Angle = -90) Then 
    CalcVeloY = Velocity 
  Else 
    CalcVeloY = Velocity * Sin(DegToRad(Angle)) 
  End If 
End Function 
 
Public Function TimeAtMaxAltitude(ByVal Angle As Double, ByVal Velocity As Double, Optional ByVal Gravity As Double = 9.81) As Double 
  TimeAtMaxAltitude = CalcVeloY(Angle, Velocity) / Gravity 
End Function 
 
Public Function AntiSin(ByVal var1 As Double) As Double 
  AntiSin = Atn(var1 / Sqr(-var1 * var1 + 1)) 
End Function 
 
Public Function AntiCos(ByVal var1 As Double) As Double 
  AntiCos = -Atn(var1 / Sqr(-var1 * var1 + 1)) + PI / 2 
'  AntiCos = Atn(-var1 / Sqr(-var1 * var1 + 1)) + 2 * Atn(1) 
End Function