Comments

This class uses recursion to walk through all the possible lotto combinations (order independent) for a given lotto pool. This code can be easily adapted to walk through a pool of Letters or Strings.

Reference

LottoClass Events

Result (Draw(), Percent, Cancel)

Complete (DrawCount)

LottoClass Properties

DrawCount

Read-Only

Return Type is a Currency. Returns the count of draws run so far

LottoClass Methods

FormatDraw ()

Return Type is a String Value. Formats the current draw in a readable format.

StartDraw PoolSize, DrawSize

Usage

Add LottoClass.cls to your project and declare it using WithEvents in the Declarations area of your Form or Class.

Private WithEvents Lotto As LottoClass

Private mStop As Boolean
Private mPercent As Long

Private Sub cmdStart_Click()

   mStop = False

   Set Lotto = New LottoClass

   mPercent = 0
   Lotto.StartDraw 40, 6

   Set Lotto = Nothing

End Sub

Private Sub cmdStop_Click()

   mStop = True

End Sub

Private Sub Lotto_Complete(DrawCount As Currency)

   Debug.Print "Total Lines: " & Lotto.DrawCount

End Sub

Private Sub Lotto_Result(Draw() As Long, Percent As Long, Cancel As Boolean)

   If mPercent <> Percent Then
      mPercent = Percent
      Debug.Print "Progress: " & Percent & "%"
   End If
   'The Draw can be easily entered into a database or saved to file
   'by either using the FormatDraw Function or Looping through the
   'Draw Array.
   'Debug.Print Lotto.FormatDraw
   Cancel = mStop

End Sub

The Code

LottoClass.cls

Option Explicit

Public Event Result(Draw() As Long, Percent As Long, Cancel As Boolean)
Public Event Complete(DrawCount As Currency)

Private Pool() As Long
Private Draw() As Long

Private mCancel As Boolean
Private mDrawCount As Currency
Private mExpectedCount As Currency

Public Property Get DrawCount() As Currency

   DrawCount = mDrawCount

End Property

Public Sub StartDraw(PoolSize As Long, DrawSize As Long)

   Dim l As Long

   mDrawCount = 0

   If (PoolSize > 0) And (PoolSize > DrawSize) Then
      ReDim Pool(PoolSize - 1)
      For l = 0 To PoolSize - 1
         Pool(l) = l + 1
      Next
   Else
      RaiseEvent Complete(mDrawCount)
      Exit Sub
   End If

   ReDim Draw(DrawSize - 1)

   CalcExpectedCount PoolSize, DrawSize

   Walk 0, 0

   Erase Pool
   Erase Draw

   RaiseEvent Complete(mDrawCount)

End Sub

Private Sub Walk(ByVal PoolIndex As Long, ByVal DrawIndex As Long)

   Dim l As Long

   For l = PoolIndex To UBound(Pool)
      Draw(DrawIndex) = Pool(l)
      If DrawIndex = UBound(Draw) Then
         mDrawCount = mDrawCount + 1
         RaiseEvent Result(Draw, Int((mDrawCount / mExpectedCount) * 100), _
         mCancel)
      Else
         Walk PoolIndex + 1, DrawIndex + 1
         PoolIndex = PoolIndex + 1
      End If
      If mCancel Then
         Exit Sub
      End If
   Next
   DoEvents

End Sub

Private Sub CalcExpectedCount(PoolSize As Long, DrawSize As Long)

   Dim c As Currency
   Dim l As Long

   c = PoolSize
   For l = 1 To DrawSize - 1
      c = c * (PoolSize - l)
   Next
   mExpectedCount = c / Factorial(CCur(DrawSize))

End Sub

Private Function Factorial(Value As Currency) As Currency

   If Value > 1 Then
      Factorial = Value * Factorial(Value - 1)
   Else
      Factorial = 1
   End If

End Function

Public Function FormatDraw() As String

   Dim l As Long
   Dim s As String

   For l = 0 To UBound(Draw)
      s = s & Draw(l) & ", "
   Next

   If Len(s) > 0 Then
      s = Left$(s, Len(s) - 2)
   End If

   FormatDraw = s

End Function

Downloads

  LottoClass.zip - contains: LottoClass.cls (1.0 kb)

© Copyright Notice

Unless otherwise stated, the code on this site is Copyright to Andrew McMillan. You may use this code in your projects (both commercial and non-commercial) but you are not permitted to republish this code in any form without the Author's prior consent.

The code on this site is supplied "as is" and no claims are made as to its soundness. The Author claims no responsibility for or liability from use of said source code.