VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



A selection of useful maths functions

by Dan T (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 12th August 2004
Date Added: Mon 8th February 2021
Rating: (1 Votes)

A selection of useful maths functions

API Declarations


'if you find any of these functions useful or if you have any suggestions for more funcions, let me know

Rate A selection of useful maths functions



Public Const Pi = 3.141592653589
Public Const RadToDegRatio = 57.29577951
Public Const DegToRadRatio = 0.01745329252

Function FactAdd(ByVal Num As Long) As Double
  'Function takes a number n and adds all numbers preceeding n to one another
  'The function does it in a slightly quicker way by utilising the triangle
  'number nature of the problem
  FactAdd = (Num + 1) * (Num / 2)
End Function

Function Factorial(ByVal Num As Long) As Integer
  Dim x As Integer
  For x = 1 To Num
    Factorial = Factorial * Num
  Next Num
End Function
Function AreaCircle(ByVal Radius As Integer) As Integer
  AreaCircle = Pi * Radius ^ 2
End Function

Function CircCircle(ByVal Radius As Integer) As Integer
  CircCircle = 2 * Pi * Radius
End Function

Function ExtAngle(ByVal NumSides As Integer) As Integer
  'Function returns external angle of a shape given number of sides
  ExtAngle = 180 - (360 / NumSides)
End Function

Function IntAngle(ByVal NumSides As Integer) As Integer
  'Function returns internal angle of a shape given number of sides
  IntAngle = (360 / NumSides)
End Function

Function AreaShape(ByVal Sidelength As Integer, ByVal NumSides As Integer) As Integer
  'Function Calculates area of any regular shape gven side length and number of sides
  Dim HLength As Integer      'Carries Height of triangles
  Dim SectionArea As Integer  'Carries areas of triangles
  HLength = (Sin(DegToRad(IntAngle(NumSides))) * Sidelength) + (Sidelength / 2)
  SectionArea = (HLength * (Sidelength / 2))
  AreaShape = SectionArea * NumSides
End Function

Function Gradiant(ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
  Gradiant = (Y2 - Y1) / (X2 - X1)
End Function

Function PointDistance(ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer)
  'Function returns distance between two points
  PointDistance = Sqr(((X2 - X1) ^ 2) + ((Y2 - Y1) ^ 2))
End Function

Function MidPoint(ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer, ByVal ReturnCoord As String) As Double
  Dim x As Double
  Dim y As Double
  x = (X1 + X2) / 2         'Calculate X Midpoint
  y = (Y1 + Y2) / 2         'Calculate Y Midpoint
  If UCase$(ReturnCoord) = "X" Or LCase$(ReturnCoord) = "x" Then
    MidPoint = x
  End If
  If UCase$(ReturnCoord) = "Y" Or LCase$(ReturnCoord) = "y" Then
    MidPoint = y
  End If
End Function

Function IsFactor(ByVal Factor As Long, ByVal Number As Long) As Boolean
  If Factor Mod Number = 0 Then   'check if Number divides into Factor exactly
    IsFactor = True               'if it does returns True
  Else
    IsFactor = False              'If it does not return false
  End If
End Function

Function Quadratic(ByVal A As Integer, ByVal B As Integer, ByVal C As Integer, ByVal ReturnNum As Integer)
  'Function Returns one of two possible values of X for a quadratic Equation of the
  'form ax^2 + bx + c = 0
  Dim X1, X2                                        'Dim Holding Variable
  
  X1 = -B + (Sqr((B ^ 2) - (4 * A * C) / (2 * A)))  'Calculate first possible value
  X2 = -B - (Sqr((B ^ 2) - (4 * A * C) / (2 * A)))  'Calculate second possible value
  
  If ReturnNum = 1 Then               'Decide which value to return
    Quadratic = X1                    'based on ReturnNum
  Else
    Quadratic = X2
  End If
End Function

Function RadToDeg(Radians As Integer) As Double
  RadToDeg = Radians * (180 / Pi)
End Function

Function DegToRad(ByVal Degrees As Integer) As Double
  DegToRad = Degrees * (Pi / 180)
End Function

Function Perpendicular(ByVal m1 As Integer, ByVal m2 As Integer) As Boolean
  'Function takes two gradiants and returns true if the lines are perpendicular
  If m1 * m2 = -1 Then
    Perpendicular = True
  Else
    Perpendicular = False
  End If
  End Function
  
Function QuadraticRoots(ByVal A As Integer, ByVal B As Integer, ByVal C As Integer) As Integer
  'Function returns state of roots of quadratic equations
  'Returns 1 for Real Different Roots
  'Returns 0 for real Same Roots
  'Returns -1 for imaginary roots

  If ((B ^ 2) - (4 * A * C)) > 0 Then QuadraticRoots = 1
  If ((B ^ 2) - (4 * A * C)) = 0 Then QuadraticRoots = 0
  If ((B ^ 2) - (4 * A * C)) < 0 Then QuadraticRoots = -1
End Function

Function ArcLength(ByVal angle As Integer, ByVal Radius As Integer) As Integer
  ArcLength = (angle / 360) * (2 * Pi * Radius)
End Function

Function SectorArea(ByVal angle As Integer, ByVal Radius As Integer) As Double
  SectorArea = (Pi * (Radius ^ 2) * angle) / 360
End Function

Function SegmentArea(ByVal angle As Integer, ByVal Radius As Integer) As Double
  SegmentArea = ((Pi * (Radius ^ 2) * angle) / 360) - ((0.5 * (Radius ^ 2) * Sin(DegToRad(angle))))
End Function

Function TriangleNum(ByVal Num As Integer) As Integer
  TriangleNum = (Num + 1) * (Num / 2)
End Function

Function SquareNum(ByVal Num As Integer) As Integer
  SquareNum = Num ^ 2
End Function

Function CubeNum(ByVal Num As Integer) As Integer
  CubeNum = Num ^ 3
End Function

Function AreaTriangleReg(ByVal Base As Integer, ByVal Height As Integer) As Double
  AreaTriangleReg = (Base * Height) / 2
End Function

Function AreaTriangleIrreg(ByVal Side1 As Integer, ByVal Side2 As Integer, ByVal Angle1 As Integer) As Long
  AreaTriangleIrreg = (1 / 2 * (Side1 * Side2 * (Sin(DegToRad(Angle1)))))
End Function
Function AreaTrapezium(ByVal TopWidth As Integer, ByVal BottomWidth As Integer, ByVal Height As Integer) As Double
  AreaTrapezium = ((BottomWidth + TopWidth) * Height) / 2
End Function

Function CylinderVol(ByVal Radius As Integer, ByVal Length As Integer) As Double
  CylinderVol = Pi * (Radius ^ 2) * Length
End Function

Function SphereVolume(ByVal Radius As Integer) As Double
  SphereVolume = (4 / 3 * (Pi * (Radius ^ 3)))
End Function

Function SphereSurface(ByVal Radius As Integer) As Double
  SphereVolume = (4 * Pi * (Radius ^ 2))
End Function

Function ConeVolume(ByVal Radius As Integer, ByVal Height As Integer) As Double
  ConeVolume = (1 / 3 * (Pi * (Radius ^ 2 * (Height))))
End Function

Function ConeSurface(ByVal Radius As Integer, ByVal Length As Integer) As Double
  ConeSurface = (Pi * (Radius ^ 2)) + (Pi * Radius * Length)
End Function

Function CosineRule(ByVal Side1 As Integer, ByVal Side2 As Integer, ByVal Angle1 As Integer) As Double
  CosineRule = Sqr((Side1 ^ 2) + (Side2 ^ 2) - 2 * Side1 * Side2 * Cos(DegToRad(Angle1)))
End Function

Function LCM(ByVal Num1 As Integer, ByVal Num2 As Integer) As Integer
  'Function returns lowest common multiple of two numbers
  Dim MultipleCount As Integer
  Dim NewTest As Integer
  Dim Larger As Integer
  LCM = 0
  If Num1 > Num2 Then
    Larger = 1
  Else
    Larger = 2
  End If
  If Larger = 1 Then
    MultipleCount = 0
    Do
      MultipleCount = MultipleCount + 1
      NewTest = Num1 * MultipleCount
      If NewTest Mod Num2 = 0 Then LCM = NewTest
    Loop Until LCM <> 0
  Else
    MultipleCount = 0
    Do
      MultipleCount = MultipleCount + 1
      NewTest = Num2 * MultipleCount
      If NewTest Mod Num1 = 0 Then LCM = NewTest
    Loop Until LCM <> 0
  End If
End Function


Download this snippet    Add to My Saved Code

A selection of useful maths functions Comments

No comments have been posted about A selection of useful maths functions. Why not be the first to post a comment about A selection of useful maths functions.

Post your comment

Subject:
Message:
0/1000 characters