⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 超级大乐透缩水选号器 Ver1.0 一款很专业
💻 FRM
📖 第 1 页 / 共 3 页
字号:
CheckBock = CheckBock + 1
OpenBoleID(Index) = True
Else
CheckBock = CheckBock - 1
OpenBoleID(Index) = False
End If

End Sub

Private Sub Command1_Click()
If CheckVock < 8 Then Exit Sub
If CheckBock < 4 Then Exit Sub
 



Combo3.Clear
Combo4.Clear
List1.Clear
List2.Clear
List4.Clear
List3.Clear
List5.Clear
List6.Clear
Command5 = True
Command6 = True
Form3.Show


For I = 0 To Combo3.ListCount - 1

Dim tmp
Dim tmpp
tmp = Split(Combo3.List(I), "+")
tmpp = Split(Combo4.List(I), "+")

Dim str() As String
str = Split(Combo3.List(I), "=")

Dim str1() As String
str1 = Split(Combo4.List(I), "=")


Dim ShowOCNum1 As Integer
Dim ShowOCNum3 As Integer
Dim ShowOCNum2 As Integer
Dim ShowOCNum4 As Integer
ShowOCNum1 = 0
ShowOCNum2 = 0
ShowOCNum3 = 0
ShowOCNum4 = 0

For Ix = 0 To 4
If OCNum(tmp(Ix)) = True Then
ShowOCNum1 = ShowOCNum1 + 1
Else
ShowOCNum3 = ShowOCNum3 + 1
End If
Next Ix

For Ic = 0 To 1
If OCNum(tmpp(Ic)) = True Then
ShowOCNum2 = ShowOCNum2 + 1
Else
ShowOCNum4 = ShowOCNum4 + 1
End If
Next Ic







Set itmX = Form3.ListView1.ListItems.Add(, , tmp(0) & "+" & tmp(1) & "+" & tmp(2) & "+" & tmp(3) & "+" & tmp(4) & " [ " & tmpp(0) & "+" & tmpp(1) & " ]")
itmX.SubItems(1) = str(UBound(str))
itmX.SubItems(2) = str1(UBound(str1))
itmX.SubItems(3) = ShowOCNum1 & ":" & ShowOCNum3
itmX.SubItems(4) = ShowOCNum2 & ":" & ShowOCNum4





Next I
Unload Me
End Sub

Private Sub Command2_Click()
For I = 0 To 34
Check1(I).Value = 1
Next I
End Sub

 

Private Sub Command3_Click()
For I = 0 To 34
If Check1(I).Value = 0 Then
Check1(I).Value = 1
Else
Check1(I).Value = 0
End If
Next I
End Sub

Private Sub Command4_Click()
For I = 0 To 11
If Check2(I).Value = 0 Then
Check2(I).Value = 1
Else
Check2(I).Value = 0
End If
Next I
End Sub

Private Sub Command5_Click()

If CheckVock < 8 Then
MsgBox "前区必须选中超过 “7” 个以上的号码!", vbExclamation, "错误的条件"
Exit Sub
End If

 


 
'Form3.Show
'Form2.Show , Form3
'Form2.Vop1.Max = Text3.Text'

'For i = 0 To Text3.Text
'Form2.Vop1.Value = i
'DoEvents
'Next i
 

 
For LisDoCmd = 1 To Text3.Text
Form2.Show , Me
Form2.Refresh
Form2.Label1.Caption = "正在添加前区号码,请稍后!"
Form2.Vop1.Max = Text3.Text

RegotoOut:

List1.Clear
List2.Clear
List3.Clear
List4.Clear





For I = 0 To 34
If OpenVoleID(I) = True Then
List1.AddItem Check1(I).Caption
End If
Next I



For I = 0 To List1.ListCount - 1
List3.AddItem List1.List(I)
Next I








Dim AcListInx As Long
AcListInx = 0

ReDim mArray(0 To 4)

For I = 0 To 4

AcListInx = AscRan(List3.ListCount)
List4.AddItem List3.List(AcListInx)
mArray(I) = List3.List(AcListInx)
List3.RemoveItem AcListInx

Next I

Dim AddCoutIndx As Integer

AddCoutIndx = 0
 
For I = 0 To 4
AddCoutIndx = AddCoutIndx + List4.List(I)
Next I

 
List4.Clear

Call QuickSort(mArray(), 0, UBound(mArray))

    For I = 0 To UBound(mArray)
        List4.AddItem mArray(I)
    Next





Dim IDOKOut As String
IDOKOut = ""


If AddCoutIndx < Text1.Text Or AddCoutIndx > Text4.Text Then
GoTo RegotoOut
Else

For I = 0 To List4.ListCount - 1
IDOKOut = IDOKOut & List4.List(I) & "+"
Next I







'-----------------------------------------------------------------
If Not Combo1.ListIndex = "-1" Then
Dim tmp
Dim tmpp
tmp = Split(IDOKOut, "+")

Dim ShowOCNum1 As Integer
 
Dim ShowOCNum3 As Integer


ShowOCNum1 = 0
 
ShowOCNum3 = 0
 

For Ix = 0 To 4
If OCNum(tmp(Ix)) = True Then
ShowOCNum1 = ShowOCNum1 + 1
Else
ShowOCNum3 = ShowOCNum3 + 1
End If
Next Ix

If Not Combo1.Text = ShowOCNum1 & ":" & ShowOCNum3 Then GoTo RegotoOut


End If


Combo3.AddItem IDOKOut & "=" & AddCoutIndx










End If


DoEvents
Form2.Vop1.Value = LisDoCmd

Next LisDoCmd





Unload Form2

End Sub

Private Sub Command6_Click()

 
If CheckBock < 4 Then
MsgBox "后区必须选中超过 “3” 个以上的号码!", vbExclamation, "错误的条件"
Exit Sub
End If


 
For LisDoCmd = 1 To Text3.Text
Form2.Show , Me
Form2.Refresh
Form2.Label1.Caption = "正在添加后区号码,请稍后!"
Form2.Vop1.Max = Text3.Text





RegotoOut:

List2.Clear
List5.Clear
List6.Clear


For I = 0 To 11
If OpenBoleID(I) = True Then
List2.AddItem Check2(I).Caption
End If
Next I



For I = 0 To List2.ListCount - 1
List5.AddItem List2.List(I)
Next I








Dim AcListInx As Long
AcListInx = 0

ReDim mArray(0 To 1)

For I = 0 To 1

AcListInx = AscRan(List5.ListCount)
List6.AddItem List5.List(AcListInx)
mArray(I) = List5.List(AcListInx)
List5.RemoveItem AcListInx

Next I

Dim AddCoutIndx As Integer

AddCoutIndx = 0
 
For I = 0 To 1
AddCoutIndx = AddCoutIndx + List6.List(I)
Next I

 
List6.Clear

Call QuickSort(mArray(), 0, UBound(mArray))

    For I = 0 To UBound(mArray)
        List6.AddItem mArray(I)
    Next





Dim IDOKOut As String
IDOKOut = ""


If AddCoutIndx < Text2.Text Or AddCoutIndx > Text5.Text Then
GoTo RegotoOut
Else

For I = 0 To List6.ListCount - 1
IDOKOut = IDOKOut & List6.List(I) & "+"
Next I







'-----------------------------------------------------------------
If Not Combo2.ListIndex = "-1" Then
Dim tmp
Dim tmpp
tmp = Split(IDOKOut, "+")

Dim ShowOCNum1 As Integer
 
Dim ShowOCNum3 As Integer


ShowOCNum1 = 0
 
ShowOCNum3 = 0
 

For Ix = 0 To 1
If OCNum(tmp(Ix)) = True Then
ShowOCNum1 = ShowOCNum1 + 1
Else
ShowOCNum3 = ShowOCNum3 + 1
End If
Next Ix

If Not Combo2.Text = ShowOCNum1 & ":" & ShowOCNum3 Then GoTo RegotoOut


End If


Combo4.AddItem IDOKOut & "=" & AddCoutIndx










End If


DoEvents
Form2.Vop1.Value = LisDoCmd

Next LisDoCmd





Unload Form2

End Sub

 

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -