intevalanly.frm

一套35选7黄河风采（兰州福利彩票）完整版。有分析、选号、筛号功能

'对各期频次表赋值++++++++++++++++++++++++++++++++++++++++++++++
ProgressBar1.max = (hhfcevn.rshhfcreport.RecordCount * Adodc3.Recordset.RecordCount) + (hhfcevn.rshhfcreport.RecordCount * 40)
ProgressBar1.Min = 0

hhfcevn.rshhfcreport.Requery
hhfcevn.rshhfcreport.MoveFirst
Do While Not hhfcevn.rshhfcreport.EOF
  point = hhfcevn.rshhfcreport.Bookmark
  jj0 = "期数<='" & hhfcevn.rshhfcreport.Fields(0).Value & "'"
  jjj = hhfcevn.rshhfcreport.Fields(0).Value
  Label1.Caption = "开始对" & Trim(jjj) & "期频次表赋值，请耐心等待......"
  DoEvents
  
'删空频次周转表
If Adodc3.Recordset.RecordCount <> 0 Then
  Adodc3.Recordset.MoveFirst
  Do While Not Adodc3.Recordset.EOF
    step = step + 1
    Adodc3.Recordset.Delete adAffectCurrent
    ProgressBar1.Value = step
    Adodc3.Recordset.MoveNext
    Loop
End If

'对 周转频次表 赋新值-----------------------------------------------------
For i = 1 To 32
step = step + 1
qurnumber = Right(Str(i + 100), 2)

jj1 = "一='" & Trim(qurnumber) & "'"
jj2 = "二='" & Trim(qurnumber) & "'"
jj3 = "三='" & Trim(qurnumber) & "'"
jj4 = "四='" & Trim(qurnumber) & "'"
jj5 = "五='" & Trim(qurnumber) & "'"
jj6 = "六='" & Trim(qurnumber) & "'"
jj7 = "七='" & Trim(qurnumber) & "'"
jj8 = "特='" & Trim(qurnumber) & "'"
jj = "(" + jj0 + " and " + jj1 + ")" + " or " + "(" + jj0 + " and " + jj2 + ")" + " or " + "(" + jj0 + " and " + jj3 + ")" + " or " + "(" + jj0 + " and " + jj4 + ")" + " or " + "(" + jj0 + " and " + jj5 + ")" + " or " + "(" + jj0 + " and " + jj6 + ")" + " or " + "(" + jj0 + " and " + jj7 + ")" + " or " + "(" + jj0 + " and " + jj8 + ")"

hhfcevn.rshhfcreport.Filter = jj

Adodc3.Recordset.AddNew
Adodc3.Recordset.Fields(0).Value = Trim(qurnumber)
Adodc3.Recordset.Fields(1).Value = hhfcevn.rshhfcreport.RecordCount
Adodc3.Recordset.Update

Adodc3.Recordset.Resync adAffectCurrent
ProgressBar1.Value = step
Next i
'完成一个 频次周转表-----------------------

hhfcevn.rshhfcreport.Filter = adFilterNone
'hhfcevn.rshhfcreport.Requery
hhfcevn.rshhfcreport.Bookmark = point

If hhfcevn.rsfrencytemp_分组.State = adStateClosed Then
hhfcevn.rsfrencytemp_分组.Open
End If
hhfcevn.rsfrencytemp_分组.Requery

Adodc4.Recordset.AddNew
Adodc4.Recordset.Fields(0).Value = jjj

hhfcevn.rsfrencytemp_分组.MoveFirst
hhfcevn.rsfrencytemp_分组.MoveLast
kk = hhfcevn.rsfrencytemp_分组.RecordCount

If kk > 8 Then
  ProgressBar1.max = ProgressBar1.max + (kk - 8)
End If
If kk < 8 Then
  ProgressBar1.max = ProgressBar1.max - (8 - kk)
End If

hhfcevn.rsfrencytemp_分组.MoveFirst

For i = 1 To kk
  step = step + 1
  Adodc4.Recordset.Fields(i).Value = hhfcevn.rsfrencytemp_分组.Fields(1).Value
  If i < kk Then
    hhfcevn.rsfrencytemp_分组.MoveNext
  End If
  ProgressBar1.Value = step
Next i

Adodc4.Recordset.Update
Adodc4.Recordset.Resync adAffectCurrent
'Adodc4.Refresh
'完成一期频次表的转换
Label1.Caption = "完成对" & Trim(jjj) & "期频次表赋值，请耐心等待......"
DoEvents
hhfcevn.rshhfcreport.MoveNext
Loop
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
step = 0
'对 间隔位置表 的 位置 赋值
Label1.Caption = "开始对 间隔位置表 的 位置 赋值，请耐心等待......"
DoEvents
ProgressBar1.max = Adodc1.Recordset.RecordCount
ProgressBar1.Min = 0

Adodc1.Recordset.MoveFirst
Do While Not Adodc1.Recordset.EOF
step = step + 1
jj = "期数='" & Trim(Str(Val(Adodc1.Recordset.Fields(5).Value) - 1)) & "'"
Adodc4.Recordset.Filter = jj
If Adodc4.Recordset.RecordCount <> 0 Then
  For i = 1 To 25
    If Adodc4.Recordset.Fields(i).Value = Adodc1.Recordset.Fields(3).Value Then
      Adodc1.Recordset.Fields(4).Value = i
      Adodc1.Recordset.Update
      Adodc1.Recordset.Resync adAffectCurrent, adResyncAllValues
      Exit For
    End If
  Next i
End If
ProgressBar1.Value = step
Adodc1.Recordset.MoveNext
Adodc4.Recordset.Filter = adFilterNone
Loop
'等待 屏幕消失
Unload frmSplashtemp
Screen.MousePointer = 0

Label1.Visible = False
ProgressBar1.Visible = False

'刷新 mshflexgrid1
If hhfcevn.rsplacefrequcy.State = adStateClosed Then
hhfcevn.rsplacefrequcy.Open
End If
hhfcevn.rsplacefrequcy.Requery
DoEvents
MSHFlexGrid1.Refresh

End If
End Sub

Private Sub CandyCommand4_Click()
'快速生成
MsgBox "此操作只对最近输入的一期进行处理，如此前输入了多期，则必须使用<数据生成>按钮重新生成数据。", vbOKOnly, "提示"
Dim topqu1 As String
Dim topqu2 As String
Adodc4.Recordset.MoveFirst
topqu2 = Adodc4.Recordset.Fields(0).Value
Do While Not Adodc4.Recordset.EOF
  If Val(Adodc4.Recordset.Fields(0).Value) > Val(topqu2) Then
    topqu2 = Adodc4.Recordset.Fields(0).Value
  End If
Adodc4.Recordset.MoveNext
Loop

hhfcevn.rshhfcreport.MoveFirst
topqu1 = hhfcevn.rshhfcreport.Fields(0).Value
Do While Not hhfcevn.rshhfcreport.EOF
  If Val(hhfcevn.rshhfcreport.Fields(0).Value) > Val(topqu1) Then
    topqu1 = hhfcevn.rshhfcreport.Fields(0).Value
  End If
hhfcevn.rshhfcreport.MoveNext
Loop

If topqu1 > topqu2 Then

'等待 窗口出现
frmSplashtemp.Show
Screen.MousePointer = 11
DoEvents

hhfcevn.rsbasicinteval.Filter = "间隔期数='" & Trim(topqu1) & "'"

'为 位置间隔数据 赋值《号码、间隔、当期频次、间隔期数》
hhfcevn.rsbasicinteval.MoveFirst
Do While Not hhfcevn.rsbasicinteval.EOF
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields(1).Value = hhfcevn.rsbasicinteval.Fields(1).Value
Adodc1.Recordset.Fields(2).Value = hhfcevn.rsbasicinteval.Fields(2).Value
Adodc1.Recordset.Fields(5).Value = hhfcevn.rsbasicinteval.Fields(6).Value

jj0 = "期数<'" & Trim(topqu1) & "'"
jj1 = "一='" & hhfcevn.rsbasicinteval.Fields(1).Value & "'"
jj2 = "二='" & hhfcevn.rsbasicinteval.Fields(1).Value & "'"
jj3 = "三='" & hhfcevn.rsbasicinteval.Fields(1).Value & "'"
jj4 = "四='" & hhfcevn.rsbasicinteval.Fields(1).Value & "'"
jj5 = "五='" & hhfcevn.rsbasicinteval.Fields(1).Value & "'"
jj6 = "六='" & hhfcevn.rsbasicinteval.Fields(1).Value & "'"
jj7 = "七='" & hhfcevn.rsbasicinteval.Fields(1).Value & "'"
jj8 = "特='" & hhfcevn.rsbasicinteval.Fields(1).Value & "'"
jj = "(" + jj0 + " and " + jj1 + ")" + " or " + "(" + jj0 + " and " + jj2 + ")" + " or " + "(" + jj0 + " and " + jj3 + ")" + " or " + "(" + jj0 + " and " + jj4 + ")" + " or " + "(" + jj0 + " and " + jj5 + ")" + " or " + "(" + jj0 + " and " + jj6 + ")" + " or " + "(" + jj0 + " and " + jj7 + ")" + " or " + "(" + jj0 + " and " + jj8 + ")"
hhfcevn.rshhfcreport.Filter = jj
Adodc1.Recordset.Fields(3).Value = hhfcevn.rshhfcreport.RecordCount
Adodc1.Recordset.Update
Adodc1.Recordset.Resync adAffectCurrent, adResyncAllValues

hhfcevn.rshhfcreport.Filter = adFilterNone
hhfcevn.rsbasicinteval.MoveNext
Loop

'删空频次周转表
If Adodc3.Recordset.RecordCount <> 0 Then
Adodc3.Recordset.MoveFirst
  Do While Not Adodc3.Recordset.EOF
    Adodc3.Recordset.Delete adAffectCurrent
    Adodc3.Recordset.MoveNext
  Loop
End If

'对 周转频次表 赋新值+++++++++++++++++++++++++++++
Dim i As Integer

jj0 = "期数<='" & Trim(topqu1) & "'"

For i = 1 To 32
qurnumber = Right(Str(i + 100), 2)

jj1 = "一='" & Trim(qurnumber) & "'"
jj2 = "二='" & Trim(qurnumber) & "'"
jj3 = "三='" & Trim(qurnumber) & "'"
jj4 = "四='" & Trim(qurnumber) & "'"
jj5 = "五='" & Trim(qurnumber) & "'"
jj6 = "六='" & Trim(qurnumber) & "'"
jj7 = "七='" & Trim(qurnumber) & "'"
jj8 = "特='" & Trim(qurnumber) & "'"
jj = "(" + jj0 + " and " + jj1 + ")" + " or " + "(" + jj0 + " and " + jj2 + ")" + " or " + "(" + jj0 + " and " + jj3 + ")" + " or " + "(" + jj0 + " and " + jj4 + ")" + " or " + "(" + jj0 + " and " + jj5 + ")" + " or " + "(" + jj0 + " and " + jj6 + ")" + " or " + "(" + jj0 + " and " + jj7 + ")" + " or " + "(" + jj0 + " and " + jj8 + ")"

hhfcevn.rshhfcreport.Filter = jj

Adodc3.Recordset.AddNew
Adodc3.Recordset.Fields(0).Value = Trim(qurnumber)
Adodc3.Recordset.Fields(1).Value = hhfcevn.rshhfcreport.RecordCount
Adodc3.Recordset.Update

Adodc3.Recordset.Resync adAffectCurrent
Next i
'++++++++++++++++++++++++++++++++++++++++++++++

hhfcevn.rshhfcreport.Filter = adFilterNone

If hhfcevn.rsfrencytemp_分组.State = adStateClosed Then
hhfcevn.rsfrencytemp_分组.Open
End If
hhfcevn.rsfrencytemp_分组.Requery

Adodc4.Recordset.AddNew
Adodc4.Recordset.Fields(0).Value = Trim(topqu1)

hhfcevn.rsfrencytemp_分组.MoveFirst
hhfcevn.rsfrencytemp_分组.MoveLast
kk = hhfcevn.rsfrencytemp_分组.RecordCount
hhfcevn.rsfrencytemp_分组.MoveFirst

'Adodc4.Refresh

For i = 1 To kk
  Adodc4.Recordset.Fields(i).Value = hhfcevn.rsfrencytemp_分组.Fields(1).Value
  If i < kk Then
    hhfcevn.rsfrencytemp_分组.MoveNext
  End If
Next i

Adodc4.Recordset.Update
Adodc4.Recordset.Resync adAffectCurrent

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'对 间隔位置表 的 位置 赋值 -------------------------
Adodc1.Recordset.MoveFirst
Do While Not Adodc1.Recordset.EOF
jj = "期数='" & Trim(Str(Val(Adodc1.Recordset.Fields(5).Value) - 1)) & "'"
  Adodc4.Recordset.Filter = jj
  If Adodc4.Recordset.RecordCount <> 0 Then
    For i = 1 To 25
      If Adodc4.Recordset.Fields(i).Value = Adodc1.Recordset.Fields(3).Value Then
        Adodc1.Recordset.Fields(4).Value = i
        Adodc1.Recordset.Update
        Adodc1.Recordset.Resync adAffectCurrent, adResyncAllValues
        Exit For
      End If
    Next i
  End If
'----------------------------------------------

Adodc1.Recordset.MoveNext
Adodc4.Recordset.Filter = adFilterNone
Loop

'等待 屏幕消失
Unload frmSplashtemp
Screen.MousePointer = 0
'刷新 mshflexgrid1
If hhfcevn.rsplacefrequcy.State = adStateClosed Then
hhfcevn.rsplacefrequcy.Open
End If
hhfcevn.rsplacefrequcy.Requery
DoEvents
MSHFlexGrid1.Refresh

Else
MsgBox "无可生成的数据，请仔细再看一遍，或进行数据生成操作。", vbOKOnly, "提示"
CandyCommand3.Enabled = False
End If

End Sub

Private Sub CandyCommand5_Click()
'选号
Load choice
choice.Show
End Sub

Private Sub CandyCommand6_Click()
Screen.MousePointer = 11
DoEvents
Dim i As Integer

Adodc5.Recordset.MoveFirst
Do While Not Adodc5.Recordset.EOF
  For i = 1 To 7
    Adodc5.Recordset.Fields(i).Value = 0
  Next i
  Adodc5.Recordset.Update
  Adodc5.Recordset.Resync adAffectCurrent, adResyncAllValues
  Adodc5.Recordset.MoveNext
Loop
Adodc5.Refresh

hhfcevn.rshhfcreport.MoveFirst
Do While Not hhfcevn.rshhfcreport.EOF
  For i = 0 To 15
    hhfcevn.rsbasicinteval.Filter = "间隔期数='" & hhfcevn.rshhfcreport.Fields(0).Value & "' and " & "间隔=" & i
      If hhfcevn.rsbasicinteval.RecordCount <> 0 Then
         Adodc5.Recordset.MoveFirst
         Adodc5.Recordset.Find "间隔组='" & Trim(Str(i)) + "间隔" & "'"
         Adodc5.Recordset.Fields(hhfcevn.rsbasicinteval.RecordCount).Value = Adodc5.Recordset.Fields(hhfcevn.rsbasicinteval.RecordCount).Value + 1
         Adodc5.Recordset.Update
         Adodc5.Recordset.Resync adAffectCurrent, adResyncAllValues
      End If
      hhfcevn.rsbasicinteval.Filter = adFilterNone
  Next i
hhfcevn.rshhfcreport.MoveNext
Loop

Adodc5.Refresh
CandyCommand6.Enabled = False
Screen.MousePointer = 0
End Sub

Private Sub Form_Load()
'Set Picture1.Container = Frame1
Adodc2.Refresh
Adodc1.Refresh
Adodc3.Refresh
Adodc4.Refresh
Adodc5.Refresh

CandyCommand3.Caption = " 生成位" & Chr(13) & " 置间隔"

If hhfcevn.rshhfcreport.State = adStateClosed Then
hhfcevn.rshhfcreport.Open
End If
hhfcevn.rshhfcreport.Requery

If hhfcevn.rsCommand1.State = adStateClosed Then
hhfcevn.rsCommand1.Open
End If
hhfcevn.rsCommand1.Requery

If hhfcevn.rsbasicinteval.State = adStateClosed Then
hhfcevn.rsbasicinteval.Open
End If
hhfcevn.rsbasicinteval.Requery

HScroll1.max = Picture1.Width - Frame1.Width
VScroll1.max = Picture1.Height - Frame1.Height

VScroll2.max = Picture2.Height - Frame2.Height

MSHFlexGrid1.RowHeight(0) = 400
MSHFlexGrid1.ColWidth(0, 0) = 150
MSHFlexGrid1.ColWidth(1, 0) = 800
MSHFlexGrid1.ColWidth(2, 0) = 500
MSHFlexGrid1.ColWidth(3, 0) = 500

MSHFlexGrid1.BackColorFixed = vbCyan
MSHFlexGrid1.BackColorSel = &HFF8080
MSHFlexGrid1.BackColor = &HFF8080

MSHFlexGrid1.MergeCol(3) = True

MSHFlexGrid2.ColWidth(0, 0) = 150
MSHFlexGrid2.ColWidth(1, 0) = 750
MSHFlexGrid2.ColWidth(2, 0) = 300
MSHFlexGrid2.ColWidth(3, 0) = 300
MSHFlexGrid2.ColWidth(4, 0) = 300
MSHFlexGrid2.ColWidth(5, 0) = 300
MSHFlexGrid2.ColWidth(6, 0) = 300
MSHFlexGrid2.ColWidth(7, 0) = 300
MSHFlexGrid2.ColWidth(8, 0) = 300

MSHFlexGrid2.BackColorFixed = vbCyan
MSHFlexGrid2.BackColorSel = &HFF8080
MSHFlexGrid2.BackColor = &HFF8080

End Sub

Private Sub HScroll1_Change()
Picture1.Left = -HScroll1.Value
End Sub


Private Sub VScroll1_Change()
Picture1.Top = -VScroll1.Value
End Sub

Private Sub VScroll2_Change()
Picture2.Top = -VScroll2.Value
End Sub