frmmain.frm

足球大王

'
'            ActiveList = cmbList.Text
'       Case "新报预测"
'
'            ActiveList = cmbList.Text
'       Case "大注推荐"
'            ActiveList = cmbList.Text
'
'       Case "初步结果"
'            ActiveList = cmbList.Text
'
'       Case "会商结果1"
'            ActiveList = cmbList.Text
'
'       Case "会商结果2"
'            ActiveList = cmbList.Text
'
'       Case "会商结果3"
'            ActiveList = cmbList.Text
'
'       Case "会商结果4"
'            ActiveList = cmbList.Text
'
'       Case "会商冷门"
'            ActiveList = cmbList.Text
'
'       Case "会商保留1"
'            ActiveList = cmbList.Text
'
'       Case "会商保留2"
'            ActiveList = cmbList.Text
'
'       Case "会商保留3"
'            ActiveList = cmbList.Text
'
'       Case "会商保留4"
'            ActiveList = cmbList.Text
'
'End Select
            
            ActiveList = cmbList.Text
'            cmdClear_Click

End Sub



Private Sub cmdClear_Click()
Dim i As Integer
For i = 0 To 12
    Me.chk0(i).Value = 1 - vbChecked
    Me.chk1(i).Value = 1 - vbChecked
    Me.chk2(i).Value = 1 - vbChecked
    
Next
End Sub

Private Sub cmdReadFrom_Click()
    Dim i As Integer
    On Error Resume Next
    
    Set rsListAct = New ADODB.Recordset
    rsListAct.Open "select * from " & ActiveList & " order by id ", DBfoot, 1, 3
    For i = 0 To 12
        If rsListAct.EOF Then Exit For
        Me.lblZhu(i).Caption = rsListAct!主场
        Me.lblKe(i).Caption = rsListAct!客场
        Me.chk2(i).Value = rsListAct!压胜
        Me.chk1(i).Value = rsListAct!压平
        Me.chk0(i).Value = rsListAct!压负
        'rsListAct.Updatef
        rsListAct.MoveNext
        
    Next

End Sub

Private Sub cmdDelete_Click()
    Dim deleteStr As String
    If Not ifOpen Then
       MsgBox ("没有打开数据库，请先打开数据库")
       Exit Sub
    End If

    
    deleteStr = "delete from document "
    DBfoot.Execute deleteStr
        
    Me.MSHFlexGrid1.Clear
    Me.txtTotal = 0

End Sub

Private Sub cmdDelZcfu_Click()
Dim i As Integer
Dim j As Integer
Dim p As Integer
 
Dim Value1 As Integer
Dim Value2 As Integer

Value1 = Val(txtZCFu1)
Value2 = Val(txtZCFu2)
 
 If Not ifOpen Then
    MsgBox ("没有打开数据库，请先打开数据库")
    Exit Sub
 End If

    Set rsFootBall = New ADODB.Recordset
    rsFootBall.Open "select * from document", DBfoot, 1, 3
    
    'p = InputBox("输入场数", "足彩大王   ", 2)
    
    While Not rsFootBall.EOF
        i = 0
        For j = 1 To 13
            If rsFootBall(j) = 0 Then i = i + 1
        Next j
        If i < Value1 Or i > Value2 Then rsFootBall.Delete adAffectCurrent
        rsFootBall.MoveNext
        
    Wend
    
    Set Me.MSHFlexGrid1.DataSource = rsFootBall
    Me.txtTotal = rsFootBall.RecordCount
    Me.MSHFlexGrid1.Refresh
For i = 0 To Me.MSHFlexGrid1.Cols - 1
    Me.MSHFlexGrid1.ColWidth(i) = Me.MSHFlexGrid1.Width / Me.MSHFlexGrid1.Cols
Next i


End Sub

Private Sub cmdDelZcPing_Click()
Dim i As Integer
Dim j As Integer
Dim p As Integer
'On Error Resume Next
Dim Value1 As Integer
Dim Value2 As Integer

Value1 = Val(txtZCPing1)
Value2 = Val(txtZCPing2)
    
 If Not ifOpen Then
    MsgBox ("没有打开数据库，请先打开数据库")
    Exit Sub
 End If
    
    Set rsFootBall = New ADODB.Recordset
    rsFootBall.Open "select * from document", DBfoot, 1, 3
    
'    p = InputBox("输入场数", "足彩大王   ", 2)
    
    While Not rsFootBall.EOF
        i = 0
        For j = 1 To 13
            If rsFootBall(j) = 1 Then i = i + 1
        Next j
        If i < Value1 Or i > Value2 Then rsFootBall.Delete adAffectCurrent
        rsFootBall.MoveNext
        
    Wend
    
    Set Me.MSHFlexGrid1.DataSource = rsFootBall
    Me.txtTotal = rsFootBall.RecordCount
For i = 0 To Me.MSHFlexGrid1.Cols - 1
    Me.MSHFlexGrid1.ColWidth(i) = Me.MSHFlexGrid1.Width / Me.MSHFlexGrid1.Cols
Next i
    
    Me.MSHFlexGrid1.Refresh
    
End Sub

Private Sub cmdDelZj_Click()
    
    'Dim ifdelete As Boolean
    Dim j As Integer
    Dim zjOk As Integer
    Dim Value1 As Integer
    Dim Value2 As Integer
    Dim ifSame As Boolean
    
    Value1 = Val(txtZj1)
    Value2 = Val(txtZj2)
    
    
 If Not ifOpen Then
    MsgBox ("没有打开数据库，请先打开数据库")
    Exit Sub
 End If
    Set rsFootBall = New ADODB.Recordset
    rsFootBall.Open "select * from document", DBfoot, 1, 3
    
    While Not rsFootBall.EOF
     '   ifdelete = True
        zjOk = 0
        For j = 1 To 13
            ifSame = True
            If rsFootBall(j) = 0 Then
                If chk0(j - 1).Value <> vbChecked Then ifSame = False
            ElseIf rsFootBall(j) = 1 Then
                If chk1(j - 1).Value <> vbChecked Then ifSame = False
            
            ElseIf rsFootBall(j) = 3 Then
                If chk2(j - 1).Value <> vbChecked Then ifSame = False
            
            End If
            
            If ifSame Then
                zjOk = zjOk + 1
            End If
             
        Next j
        
        
        
        If zjOk < Value1 Or zjOk > Value2 Then
            rsFootBall.Delete adAffectCurrent
        End If
        rsFootBall.MoveNext
        
    Wend
    
    Set Me.MSHFlexGrid1.DataSource = rsFootBall
    Me.txtTotal = rsFootBall.RecordCount
    Me.MSHFlexGrid1.Refresh

End Sub

Private Sub cmdDo_Click()
Dim i, j, k, l, m, n, o, p, q, r, s, t, u As Integer
Dim userCheckStart(13) As Integer
Dim usercheckend(13) As Integer
Dim Fvalue(13, 3) As Integer
 
 If Not ifOpen Then
    MsgBox ("没有打开数据库，请先打开数据库")
    Exit Sub
 End If



For i = 1 To 13
    
    userCheckStart(i) = 0
    usercheckend(i) = -1
    
    If chk0(i - 1).Value = vbChecked Then
        'userCheckStart(i) = 0
        usercheckend(i) = usercheckend(i) + 1
        Fvalue(i, usercheckend(i)) = 0
    End If
    
    If chk1(i - 1).Value = vbChecked Then
        usercheckend(i) = usercheckend(i) + 1
        Fvalue(i, usercheckend(i)) = 1
    End If
    
    If chk2(i - 1).Value = vbChecked Then
        usercheckend(i) = usercheckend(i) + 1
        Fvalue(i, usercheckend(i)) = 3
    End If
    
    If usercheckend(i) = -1 Then
        MsgBox "错误," & Str(i) & "组为空！", vbOKOnly
        Exit Sub
    End If
Next i

Set rsFootBall = New ADODB.Recordset
rsFootBall.Open "select * from document", DBfoot, 1, 3

For i = userCheckStart(1) To usercheckend(1)
    For j = userCheckStart(2) To usercheckend(2)
    For k = userCheckStart(3) To usercheckend(3)
    For l = userCheckStart(4) To usercheckend(4)
    For m = userCheckStart(5) To usercheckend(5)
    For n = userCheckStart(6) To usercheckend(6)
    For o = userCheckStart(7) To usercheckend(7)
    DoEvents
    For p = userCheckStart(8) To usercheckend(8)
    For q = userCheckStart(9) To usercheckend(9)
    For r = userCheckStart(10) To usercheckend(10)
    For s = userCheckStart(11) To usercheckend(11)
    For t = userCheckStart(12) To usercheckend(12)
    For u = userCheckStart(13) To usercheckend(13)
        
        rsFootBall.AddNew
        rsFootBall(1) = Fvalue(1, i)
        rsFootBall(2) = Fvalue(2, j)
        rsFootBall(3) = Fvalue(3, k)
        rsFootBall(4) = Fvalue(4, l)
        rsFootBall(5) = Fvalue(5, m)
        rsFootBall(6) = Fvalue(6, n)
        rsFootBall(7) = Fvalue(7, o)
        rsFootBall(8) = Fvalue(8, p)
        rsFootBall(9) = Fvalue(9, q)
        rsFootBall(10) = Fvalue(10, r)
        rsFootBall(11) = Fvalue(11, s)
        rsFootBall(12) = Fvalue(12, t)
        rsFootBall(13) = Fvalue(13, u)
        
    Next
    Next
    Next
    Next
    Next
    Next
    Next
    Next
    Next
    Next
    Next
    Next
Next i
rsFootBall.Update
Set Me.MSHFlexGrid1.DataSource = rsFootBall
For i = 0 To Me.MSHFlexGrid1.Cols - 1
    Me.MSHFlexGrid1.ColWidth(i) = Me.MSHFlexGrid1.Width / Me.MSHFlexGrid1.Cols - 30
Next i

Me.txtTotal = rsFootBall.RecordCount
Me.MSHFlexGrid1.Refresh



End Sub

Private Sub cmdExit_Click()
MsgBox ("谢谢您使用本系统，祝您中奖发财！")
Unload Me
End
End Sub

Private Sub cmdFirst_Click()
Dim i As Integer
Dim GroupId As Integer
Dim FootBallId As Integer
Dim ifDiffOne As Boolean
Dim diffNum As Integer
Dim DiffValue As Integer
Dim diffTotal As Integer

'On Error Resume Next

 
 If Not ifOpen Then
    MsgBox ("没有打开数据库，请先打开数据库")
    Exit Sub
 End If

   
    Set rsGroup = New ADODB.Recordset
    rsGroup.Open "select * from group2", DBfoot, 1, 3
    
    Set rsFootBall = New ADODB.Recordset
    rsFootBall.Open "select * from pgroup order by id", DBfoot, 1, 3
    
    
    While Not rsGroup.EOF
        rsFootBall.AddNew
        For i = 1 To 14
            rsFootBall(i) = rsGroup(i)
        Next i
        rsFootBall.Update
        rsGroup.MoveNext
    Wend
    
    Set rsGroup = New ADODB.Recordset
    rsGroup.Open "delete  from group2", DBfoot, 1, 3
    
    
    Set rsGroup = New ADODB.Recordset
    rsGroup.Open "select * from group2", DBfoot, 1, 3
    
    
While 1
        
    Set rsFootBall = New ADODB.Recordset
    
    If Me.cmbGroupSet.Text = "全部" Then
        rsFootBall.Open "select * from pgroup order by id", DBfoot, 1, 3
    Else
        rsFootBall.Open "select top " & Me.cmbGroupSet.Text & "  * from pgroup order by id", DBfoot, 1, 3
    End If
    
    If rsFootBall.RecordCount < 1 Then GoTo exitWhile
    rsFootBall.MoveFirst
    DoEvents
    
    rsGroup.AddNew
        
    For i = 1 To 14
        rsGroup(i) = rsFootBall(i)
    Next i
'        rsGroup(14) = 1
        
'    rsGroup.Update
        
    GroupId = rsGroup!Id
        
    rsFootBall.Delete adAffectCurrent
    rsFootBall.MoveNext
    
    While Not rsFootBall.EOF
 '       DoEvents
        
        diffTotal = 0
        diffNum = 0
        For i = 1 To 13
            If rsFootBall(i) <> rsGroup(i) Then
                If diffNum = 0 Then
                    diffNum = i
                    DiffValue = rsFootBall(i)
                End If
                    diffTotal = diffTotal + 1
                If diffTotal >= 2 Then Exit For
            End If
        Next i
        
        If diffTotal = 1 Then
                rsFootBall.Delete adAffectCurrent
                
                If rsGroup(diffNum) < 10 Then
                    If rsGroup(diffNum) > DiffValue Then
                        rsGroup(diffNum) = rsGroup(diffNum) * 10 + DiffValue
                    Else
                        rsGroup(diffNum) = 10 * DiffValue + rsGroup(diffNum)
                    
                    End If
                    
                Else
                    rsGroup(diffNum) = 310
                End If
                rsGroup(14) = rsGroup(14) + 1
               GoTo ThemoveNext
        End If
        
        rsFootBall.MoveNext
        
    Wend