Simuler la Fonction Rnd()

Commenter

Contenu du snippet 

 Const xA = 16598013
 Const xC = 12820163
 Const xM = 16777216
 Const xI = 602453
 Dim Seed As Long
 
 Private Sub Form_Load()
     Seed = 327680
 End Sub
 
 'simule la Fonction Rnd()
 Private Function Random() As Single
     Dim s As Long
     Dim x As Currency
     x = CCur(xA) * Seed + xC
     Seed = x - Int(x / xM) * xM
     Random = Seed / xM
 End Function
 
 'calcul le seed pour la valeur suivante
 Private Sub CalculSeed(r As Single)
     Seed = CCur(xM) * r
 End Sub
 
 'calcul le seed précédent
 Private Sub SeedPrecedent(s As Long)
     Dim x As Currency
     x = (s - xC) * CCur(xI)
     Seed = x - Int(x / xM) * xM
 End Sub
 
 'cherche la valeur correspondant à un seed
 Private Function ChercheSeed(s As Long) As Long
     Dim i As Long
     For i = 1 To 24143031
         Rnd -i
         CalculSeed Rnd
         SeedPrecedent Seed
         If Seed = s Then
            ChercheSeed = i
            Exit For
            End If
         If i And &H1FFFF Then DoEvents
         Next
     Beep
 End Function
 
 '//exemples d'utilisation:
 
 '//retrouve les valeurs initiales de la fonction Rnd()
 Private Sub Command1_Click()
     Dim i As Integer
     For i = 1 To 10
         MsgBox Random & vbCrLf & Rnd
         Next
 End Sub
 
 '//après un Randomize il faut recalculer le seed
 Private Sub Command2_Click()
     Randomize Timer
     CalculSeed Rnd
     MsgBox Random & vbCrLf & Rnd
 End Sub
 
 '//retrouve les valeurs dans l'ordre inverse
 Private Sub Command3_Click()
     Dim i     As Integer
     Dim r(10) As Single
     
     Randomize Timer
     For i = 1 To 10
         r(i) = Rnd
         Next
         
     CalculSeed Rnd
     SeedPrecedent Seed
     For i = 10 To 1 Step -1
         SeedPrecedent Seed
         MsgBox Random & vbCrLf & r(i)
         SeedPrecedent Seed
         Next
     CalculSeed Rnd
 
 End Sub
 
 '//initialise Rnd() avec un seed particulier
 Private Sub Command4_Click()
     Dim s As Long
     Dim R As Long
 
     s = 123456
     R = ChercheSeed(s)
     If R > 0 Then
        SeedPrecedent s
        MsgBox Random & vbCrLf & Rnd(-R)
        Rnd -R
        Seed = s
        MsgBox Random & vbCrLf & Rnd
        End If
 
 End Sub

Compatibilité : VB6

Disponible dans d'autres langages :

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 (Gobillot)