by MichaelSimone (1 Submission)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 14th October 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
No comments have been posted about Program will calculate all the possible combinations/permutations of double/single digit numbers. D. Why not be the first to post a comment about Program will calculate all the possible combinations/permutations of double/single digit numbers. D.