frmmain.frm

足球大王

    
ThemoveNext:
    rsGroup.MoveNext
    

Wend


'rsFootBall.Update
exitWhile:
Set Me.MSHFlexGrid2.DataSource = rsGroup
Me.txtGroupEnd = rsGroup.RecordCount
For i = 0 To Me.MSHFlexGrid2.Cols - 1
    Me.MSHFlexGrid2.ColWidth(i) = Me.MSHFlexGrid2.Width / Me.MSHFlexGrid2.Cols - 30
Next i

Me.txtGroupEnd = rsGroup.RecordCount
Me.MSHFlexGrid1.Refresh
cmdFirst.Enabled = False
End Sub

Private Sub cmdGroupClear_Click()
 Dim i As Integer
 If Not ifOpen Then
    MsgBox ("没有打开数据库，请先打开数据库")
    Exit Sub
 End If
    
    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
    
    Set rsFootBall = New ADODB.Recordset
    rsFootBall.Open "select * from document ", DBfoot, 1, 3
    
    While Not rsFootBall.EOF
        rsGroup.AddNew
        
        For i = 1 To 13
            rsGroup(i) = rsFootBall(i)
        Next i
        rsGroup(14) = 1
        rsGroup.Update
        
        rsFootBall.MoveNext
        'Me.MSHFlexGrid2.Refresh
    Wend
    Set Me.MSHFlexGrid2.DataSource = rsGroup
    
For i = 0 To Me.MSHFlexGrid2.Cols - 1
    Me.MSHFlexGrid2.ColWidth(i) = (Me.MSHFlexGrid2.Width - 300) / Me.MSHFlexGrid2.Cols - 30
Next i

Me.txtGroupStart = rsGroup.RecordCount
'Me.MSHFlexGrid2.Refresh
cmdFirst.Enabled = True

End Sub

Private Sub cmdSaveTo_Click()
    Dim i As Integer
    
    Dim yesNo As Boolean
    
    If MsgBox("真的要覆盖原有的结果吗？", vbYesNo, "提示") = vbYes Then
    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 rsListAct.AddNew
        rsListAct!主场 = 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.Update
        rsListAct.MoveNext
        
    Next
    
    End If
End Sub


Private Sub cmdSingleLost_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
Dim FootballPower As Integer
Dim GroupPower As Integer


 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 13
            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
    
    Set rsFootBall = New ADODB.Recordset
    rsFootBall.Open "select * from pgroup order by id", DBfoot, 1, 3
    
    
While 1
    
    If rsFootBall.RecordCount < 1 Then GoTo exitWhile
    
    rsFootBall.MoveFirst
    rsGroup.AddNew
        For i = 1 To 13
            rsGroup(i) = rsFootBall(i)
        Next i
        
'    rsGroup.Update
        
    GroupId = rsGroup!Id
        
    rsFootBall.Delete adAffectCurrent
    rsFootBall.MoveNext
    
    While Not rsFootBall.EOF
 '       DoEvents
        diffTotal = 0
        diffNum = 0
        FootballPower = 0
        GroupPower = 0
        
        For i = 1 To 13
            
            If rsFootBall(i) = 310 Then
                FootballPower = FootballPower + 2
            ElseIf rsFootBall(i) >= 10 Then
                FootballPower = FootballPower + 1
            End If
            
            If rsGroup(i) = 310 Then
                GroupPower = GroupPower + 2
            ElseIf rsGroup(i) >= 10 Then
                GroupPower = GroupPower + 1
            End If
            
            If InStr(1, Trim(Str(rsGroup(i))), Trim(Str(rsFootBall(i)))) < 1 Then
                If diffNum = 0 Then
                    diffNum = i
                    DiffValue = rsFootBall(i)
                End If
                    diffTotal = diffTotal + 1
                    If diffTotal >= 2 Then Exit For
            End If
        
            If FootballPower >= 2 Then Exit For
            If GroupPower >= 3 Then Exit For
        
        Next i
        
        If diffTotal = 1 Then
            If FootballPower = 0 And GroupPower = 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
            End If
        End If
        
        rsFootBall.MoveNext
        
    Wend
    rsGroup.MoveNext
    

Wend


'rsFootBall.Update
exitWhile:
Set Me.MSHFlexGrid2.DataSource = rsGroup
Me.txtGroupEnd = rsGroup.RecordCount
For i = 0 To Me.MSHFlexGrid2.Cols - 1
    Me.MSHFlexGrid2.ColWidth(i) = Me.MSHFlexGrid2.Width / Me.MSHFlexGrid2.Cols - 30
Next i

Me.txtGroupEnd = rsGroup.RecordCount
Me.MSHFlexGrid1.Refresh


End Sub

Private Sub cmdTrueGroup_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

 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
    
    Me.txtGroupStart = Me.txtGroupEnd
'    Set rsFootBall = New ADODB.Recordset
'    rsFootBall.Open "select * from pgroup order by id", 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
    rsGroup.AddNew
        For i = 1 To 14
            rsGroup(i) = rsFootBall(i)
        Next i
        
'    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
                    rsGroup(14) = rsGroup(14) * 2
                Else
                    rsGroup(diffNum) = 310
                    
                    rsGroup(14) = rsGroup(14) * 3 / 2
                End If
        End If
        
        rsFootBall.MoveNext
        
    Wend
    rsGroup.MoveNext
    

Wend


'rsFootBall.Update
exitWhile:
Set Me.MSHFlexGrid2.DataSource = rsGroup
Me.txtGroupEnd = rsGroup.RecordCount
For i = 0 To Me.MSHFlexGrid2.Cols - 1
    Me.MSHFlexGrid2.ColWidth(i) = Me.MSHFlexGrid2.Width / Me.MSHFlexGrid2.Cols - 30
Next i

Me.txtGroupEnd = rsGroup.RecordCount
Me.MSHFlexGrid1.Refresh

End Sub

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

Value1 = Val(txtZcSheng1)
Value2 = Val(txtZcSheng2)
 
 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) = 3 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 cmdZuFu_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 And chk2(j - 1).Value = vbChecked 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 cmdZuPing_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(txtZCPin