|
|
|
|
穷举彩票号码的通用过程 |
|
|
|
作者：未知 来源：月光软件站 加入时间：2005-5-13 月光软件站 |
Text1输入数字总个数；Text2输入每组的数字个数；App.Path & "\1.txt"用于看输出结果；Label1用于显示组个数；Command1就是执行按钮。这是一个穷举组合结果的万能代码。
Option Explicit
Private mlngAllNumCount As Long, mlngGetNumCount As Long
Private mblnCancelProc As Boolean, mlngCurResultCount As Long
Private mastrOneResult() As String
Private mlngFileNo As Long
Private Sub ListNum(ByVal Start As Long, ByVal Level As Long)
Dim i As Long
If mblnCancelProc Then Exit Sub
For i = Start To mlngAllNumCount - mlngGetNumCount + Level
mastrOneResult(Level) = i
If Level < mlngGetNumCount Then '是否到了最底层
ListNum i + 1, Level + 1 '没到底，递归啦，这是本过程的核心，很简单哟
Else
Print #mlngFileNo, Join(mastrOneResult, vbTab) '递归到最深层，就可以输出了
mlngCurResultCount = mlngCurResultCount + 1
If mlngCurResultCount Mod &H2000& = 0 Then
Label1.Caption = mlngCurResultCount '显示实际找出了多少组数字
DoEvents
End If
End If
Next
End Sub
Private Sub Command1_Click()
Dim t As Single, i As Long
If Command1.Caption = "处理" Then
mlngAllNumCount = Text1.Text '数字总个数
mlngGetNumCount = Text2.Text '每组要取的数字个数
i = Zhuhe(mlngAllNumCount, mlngGetNumCount)
If i = 0 Then
MsgBox "结果太多，请不要尝试了！"
Exit Sub
End If
Label2.Caption = i
t = Timer
mblnCancelProc = False
Command1.Caption = "停止"
mlngCurResultCount = 0 '已产生出的组合总数
ReDim mastrOneResult(1 To mlngGetNumCount)
mlngFileNo = FreeFile
Open App.Path & "\1.txt" For Output As #mlngFileNo
ListNum 1, 1
Close #mlngFileNo
Label1.Caption = mlngCurResultCount
Command1.Caption = "处理"
Me.Caption = Timer - t
Else
mblnCancelProc = True
End If
End Sub
Private Function Zhuhe(AllNum As Long, GetNum As Long) As Long
'算组合总数的过程，为防溢出，而做了特别设计
'只要结果总数在20亿以内，都不会溢出的
'太大的数不太可能会完成穷举，本程序也就不做尝试了
'接近溢出的上限列举：65536取2、2345取3、477取4、193取5、110取6
'75取7、58取8、49取9、40取10、39取11、37取12、35取13、34取15、33取16等
Dim i As Long, j As Long, colget As Collection
Dim m As Long, n As Long, Num1 As Long, Num2 As Long
On Error GoTo fail
Num1 = 1
Set colget = New Collection
For i = GetNum To 2 Step -1
colget.Add i
Next
For i = AllNum To AllNum - GetNum + 1 Step -1
m = colget.Count
If m > 0 Then
n = m
For j = 1 To m
If j > n Then Exit For
If Num1 Mod colget(j) = 0 Then
Num1 = Num1 \ colget(j)
colget.Remove j
n = n - 1
j = j - 1
End If
Next
End If
Num2 = i
m = colget.Count
If m > 0 Then
n = m
For j = 1 To m
If j > n Then Exit For
If Num2 Mod colget(j) = 0 Then
Num2 = Num2 \ colget(j)
colget.Remove j
n = n - 1
j = j - 1
End If
Next
End If
Num1 = Num1 * Num2 '分子中的两个乘数分别消去分母再相乘，可防中间过程的溢出
Next
Zhuhe = Num1
Exit Function
fail:
End Function
Private Sub Form_Load()
Command1.Caption = "处理"
End Sub
Private Sub Form_Unload(Cancel As Integer)
mblnCancelProc = True
End Sub
|
|
相关文章：相关软件： |
|
本类阅读TOP10