VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



Yours Truly Rnd (updated)

by ULLI (93 Submissions)
Category: Miscellaneous
Compatability: VB Script
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: (10 Votes)

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

Rate Yours Truly Rnd (updated)

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

Download this snippet    Add to My Saved Code

Yours Truly Rnd (updated) Comments

No comments have been posted about Yours Truly Rnd (updated). Why not be the first to post a comment about Yours Truly Rnd (updated).

Post your comment

Subject:
Message:
0/1000 characters