|
|
穷举彩票号码的通用过程 |
|
|
作者:未知 来源:月光软件站 加入时间: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
|
|
相关文章:相关软件: |
|