• Home
 · 
• Miscellaneous
 · 
• Yours Truly Rnd (updated)

Yours Truly Rnd (updated)

This little code snippet returns a truly random sequence of Rnd's

Rate Yours Truly Rnd (updated)

• 1
• 2
• 3
• 4
• 5

(11(11 Vote))

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