• Home
 · 
• String Manipulation
 · 
• Program will calculate all the possible combinations/permutations of double/single digit numbers. D

Program will calculate all the possible combinations/permutations of double/single digit numbers. D

Program will calculate all the possible combinations/permutations of double/single digit numbers. Developed for use in Totalization system

API Declarations


'* Combination Number Generator
'* By MICHAEL F SIMONE
'* Date: 08/20/2004
'* [email protected]
'*
'* I wrote this because most of the permutation/combination generator
'* only delt with single digit number strings and I needed one that
'* would handle double digits numbers within the string
'*
'* This program will generate all possible combination from the given
'* set of numbers provided including Double digit Numbers
'* By setting the Combo size number to a number between 1 and the
'* number of numbers in the pool the routine will return all possible
'* combinations for the combo size given
'* You MUST enter a "," seperator at the end of the number string
'*
'* Be sure to ad a form named frmCombo.


Option Explicit

Dim CNT As Long ' Used to calculate total of combimations
Dim iSize As Integer ' Indicates the number of digits for the combination you want to show.


Dim sSpacer As String
Dim Arry() As Variant



Rate Program will calculate all the possible combinations/permutations of double/single digit numbers. D

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    Unload Me

End Sub

Private Sub cmdNew_Click()
    lboResults.Clear
    txtNumbers.Text = ""
    txtSize.Text = 1
    txtNumbers.SetFocus

End Sub

Private Sub cmdRun_Click()
Dim A, B, J, sNum$, iMax%
    
    'Test for Comma Seperator at end of string
    If Mid$(txtNumbers, Len(txtNumbers), 1) <> "," Then
        MsgBox "You MUST enter a comma seperator at the end of the series of pool numbers!", vbExclamation
        Exit Sub
    End If
    
    lboResults.Clear
    sSpacer = " "
    'Set the Combo Count to zero
    CNT = 0
    StatusBar1.Panels(2).Text = CNT
    StatusBar1.Refresh
    
    'Split out the Numbers and put into a string
    'We also need to pad any single digit numbers
    'with a leading zero, making the entire
    'string of numbers in equal length
    A = Split(Trim$(txtNumbers), ",")
    B = 0
    For J = 1 To UBound(A)
        If B > UBound(A) Then B = 0
        'Pad leading zero to single digit numbers
        If Len(A(B)) = 1 Then A(B) = "0" & A(B)
        sNum = sNum & A(B)
        B = B + 1
    Next J
    
    iSize = Val(txtSize)
    iMax = Len(sNum) / 2
    Screen.MousePointer = vbHourglass
    pbrCombos.Min = 0
    pbrCombos.Max = Permutation(iMax, iSize)
    pbrCombos.Visible = True
    
    If cmdRun.Caption = "&RUN" Then
        txtNumbers.Enabled = False
        cmdRun.Caption = "&Stop"
        
        Call DoCombo(sNum, , iSize)
        
        pbrCombos.Visible = False
        StatusBar1.Panels(2).Text = Format(CNT, "#,###")
        cmdRun.Caption = "&RUN"
        txtNumbers.Enabled = True
        Screen.MousePointer = vbDefault
    ElseIf cmdRun.Caption = "&Stop" Then
        Screen.MousePointer = vbDefault
        End
    Else
        txtNumbers.Enabled = True
        cmdRun.Caption = "&RUN"
        Screen.MousePointer = vbDefault
    End If

End Sub


Private Sub DoCombo(strIn As String, Optional sFixed As String, Optional ByRef vSize)
'This routine will continue to loop back and through
'each set of numbers until the end of each series or group is reached
Dim iloop As Integer, xLoop As Integer
Dim Fixed As String, sNew As String, Combo As String
Dim S1$, S2$, i%, J%, sLen%, fixLen%, strLen%
    
    sLen = Len(strIn)
    If sLen <> 0 Then
        For iloop = 1 To sLen Step 2
            S1 = Left$(strIn, (iloop + 1) - 2)
            S2 = Mid$(strIn, iloop + 2)
            sNew = S1 & S2
            Fixed = sFixed & Mid$(strIn, iloop, 2)
            fixLen = Len(Fixed) / 2
            'Now just peel off the Combo Digit Size you requested
            'if the fixLen = the given Combo Size
            If fixLen = vSize Then
                CNT = CNT + 1
                pbrCombos.Value = CNT
                Combo = ""
                For xLoop = 1 To Len(Fixed) Step 2
                    ReDim Preserve Arry(J)
                    Arry(J) = Mid$(Fixed, xLoop, 2)
                    Combo = Combo & " " & Abs(Arry(J)) & sSpacer
                    J = J + 1
                Next xLoop
                lboResults.AddItem "Combo:   " & Combo
            End If
            Call DoCombo(sNew, Fixed, vSize)
        Next iloop
    End If

End Sub

Private Function Permutation(n As Integer, r As Integer) As Double
Dim u As Long, v%, t%

    If n < 1 Or r < 1 Then
       Permutation = 0
    Else
       If r > n Then
          Permutation = 0
       Else
          u = 1
          For t = 1 To n
              u = u * t
          Next t
          v = 1
          If n > r Then
             For t = 1 To n - r
                 v = v * t
             Next t
             Permutation = u / v
          Else
             Permutation = u
          End If
       End If
    End If
    
End Function

Private Sub Form_Load()
    pbrCombos.Visible = False
    
End Sub