Conversions mathematiques

Commenter

Contenu du snippet

Différentes routines pour différentes conversions:
-DeclToFrac: Convertir une valeur en fraction
ex: Call DeclToFrac(0.125, a, b) returne 1 en a et 8 en b
-BinToDec: Convertit une valeur binaire en valeur décimale
-DegreesToRadians: Convertit les degrès en radians
-RadiansToDegrees: Convertit les radians en degrés
-IsPrime: Savoir si un nombre est premier

Source / Exemple : 


'Convertit un nombre décimal en fraction
Sub DecToFrac(DecimalNum As Double, Numerator As Long, Denom As Long)

   Const BigNumber = 50000
   Const SmallNumber = 1E-16
   Dim Inverse As Double, FractionalPart As Double
   Dim WholePart As Long, SwapTemp As Long

   Inverse = 1 / DecimalNum
   WholePart = Int(Inverse)
   FractionalPart = Frac(Inverse)

   If 1 / (FractionalPart + SmallNumber) < BigNumber Then

        Call DecToFrac(FractionalPart, Numerator, Denom)
        Numerator = Denom * WholePart + Numerator

        SwapTemp = Numerator
        Numerator = Denom
        Denom = SwapTemp
   Else

        Numerator = 1
        Denom = Int(Inverse)
   End If
End Sub

Function Frac(x As Double) As Double
    Frac = Abs(Abs(x) - Int(Abs(x)))
End Function

Sub DecToProperFrac(x As Double, a As Long, b As Long, c As Long)
   If x > 1 Then a = Int(x)
   If Frac(x) <> 0 Then 
      Call DecToFrac(Frac(x), b, c)
   End If
End Sub

'-----------------------------

 
' Convertit un nombre binaire en décimal
Function BinToDec(value As String) As Long
    Dim result As Long, i As Integer, exponent As Integer
    For i = Len(value) To 1 Step -1
        Select Case Asc(Mid$(value, i, 1))
            Case 48     
            Case 49                     
          result = result Or Power2(exponent)
            Case Else
                Err.Raise 5             
           End Select
        exponent = exponent + 1
    Next
    BinToDec = result
End Function

Function Power2(ByVal exponent As Long) As Long
    Static res(0 To 31) As Long
    Dim i As Long

    If exponent < 0 Or exponent > 31 Then Err.Raise 5

    If res(0) = 0 Then
        res(0) = 1
        For i = 1 To 30
            res(i) = res(i - 1) * 2
        Next
        res(31) = &H80000000
    End If

    Power2 = res(exponent)
        
End Function

'------------------------------

' convertit les degrès en radians

Function DegreesToRadians(ByVal degrees As Single) As Single
    DegreesToRadians = degrees / 57.29578
End Function

'--------------------------

' convertit les radians en degrés

Function RadiansToDegrees(ByVal radians As Single) As Single
    RadiansToDegrees = radians * 57.29578
End Function

'-----------------------------

Function IsPrime(ByVal number As Long) As Boolean
    If number > 3 Then
        If number Mod 2 = 0 Then Exit Function
        If number Mod 3 = 0 Then Exit Function
    End If

    Dim divisor As Long
    Dim increment As Long
    Dim maxDivisor As Long
    
    divisor = 5
    increment = 2

    maxDivisor = Sqr(number) + 1
    
    Do Until divisor > maxDivisor
        If number Mod divisor = 0 Then Exit Function
        divisor = divisor + increment
        increment = 6 - increment
    Loop

    IsPrime = True
    
End Function

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Tilois)