Yours Truly - Rnd (updated)
This little code snippet returns a truly random sequence of Rnd's
Original Author: Ulli
Code
Option Explicit
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As TwoLongs) As Long
Private Type TwoLongs
l1 As Long
l2 As Long
End Type
Public Function IsCpuSuitable() As Boolean
Dim c As Currency
On Error Resume Next
IsCpuSuitable = CBool(QueryPerformanceFrequency(c))
On Error GoTo 0
End Function
Public Function TrueRnd() As Single
'returns a truly random sequence of rnd's
Dim tl As TwoLongs
Dim Seed As Long
Dim Tmp As Long
Do Until Seed > &H3FFFFFFF
QueryPerformanceCounter tl
Tmp = tl.l1 And 1
QueryPerformanceCounter tl
If Tmp <> (tl.l1 And 1) Then
Seed = Seed + Seed + Tmp
End If
Loop
TrueRnd = Rnd(-Seed)
End Function
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.