home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Bingo_-_1_2067635262007.psc / clsBingo.cls < prev    next >
Text File  |  2007-05-26  |  1KB  |  57 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsBingo"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Dim i As Long
  17. Dim i0 As Long
  18.  
  19. Dim UsedCol As Collection
  20.  
  21. Public Sub GoNext()
  22.     i = i + 1
  23. End Sub
  24.  
  25. Public Function RandomNumber() As Double
  26.     Dim r As Double
  27.     Dim count As Double
  28.     Dim lMin As Long
  29.     Dim lMax As Long
  30.     Dim j As Long
  31.     
  32.     ' Remember, we are picking random numbers down the columns WITHOUT repeats!
  33.     If i > 4 Or (UsedCol Is Nothing) Then
  34.         i = 0
  35.         If Not UsedCol Is Nothing Then i0 = i0 + 1
  36.         Set UsedCol = New Collection
  37.     End If
  38.     
  39.     lMin = i0 * 15 + 1
  40.     lMax = (i0 + 1) * 15
  41.     
  42.     count = 0
  43.     DoEvents
  44.     r = RandInt(1, 15 - UsedCol.count)
  45.     For j = lMin To lMax
  46.         If Not NumberFound(j, UsedCol) Then
  47.             count = count + 1
  48.             If r = count Then
  49.                 RandomNumber = j
  50.                 UsedCol.Add j
  51.                 i = i + 1
  52.                 Exit For
  53.             End If
  54.         End If
  55.     Next
  56. End Function
  57.