intefurther.frm

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

Dim jj0 As String
Dim jj1 As String
Dim jj2 As String
Dim jj3 As String
Dim jj5 As String
Dim jj6 As String
Dim jj7 As String
Dim jj8 As String
Dim jj4 As String
Dim jj As String
Dim jjj As String

Dim qurnumber As String

Dim kk As Integer

Dim step As Integer
Private Sub CandyCommand3_Click()
'生成位置间隔数据
Dim point As Variant
step = 0

Dim message As Integer
message = MsgBox("此操作将花费较长的时间，如果此前的数据无误，" + Chr(13) + "请按<快速生成>按钮，会以较短的时间达到同样的效果。" + Chr(13) + "继续吗？", vbYesNo, "提示")
If message = vbYes Then
'等待 窗口出现
frmSplashtemp.Show
Screen.MousePointer = 11
DoEvents

Label1.Visible = True
ProgressBar1.Visible = True
Label1.Caption = "开始生成数据，请耐心等待......"
DoEvents

'删空位置间隔数据一
If Adodc1.Recordset.RecordCount <> 0 Then
Label1.Caption = "开始删空位置间隔数据，请耐心等待......"
DoEvents
ProgressBar1.max = Adodc1.Recordset.RecordCount
ProgressBar1.Min = 0

  Adodc1.Recordset.MoveFirst
  Do While Not Adodc1.Recordset.EOF
    step = step + 1
    Adodc1.Recordset.Delete adAffectCurrent
    ProgressBar1.Value = step
    Adodc1.Recordset.MoveNext
  Loop
End If
step = 0

'从基本间隔数据表中导入‘自编、号码、间隔和间隔期数‘~~~~~~~~~~~~~~~~~~~~~~~~~~~
 hhfcevn.Commands("placeinteval").Execute
 DoEvents
 Adodc1.Refresh
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DoEvents
'为 位置间隔数据 的 当期频次 赋值
Label1.Caption = "开始为位置间隔数据的当期频次赋值，请耐心等待......"
DoEvents
Adodc1.Recordset.MoveLast
Adodc1.Recordset.MoveFirst
ProgressBar1.max = Adodc1.Recordset.RecordCount
ProgressBar1.Min = 0

Adodc1.Recordset.MoveFirst
Do While Not Adodc1.Recordset.EOF
  step = step + 1
  jj0 = "期数<'" & Adodc1.Recordset.Fields(5).Value & "'"
  jj1 = "一='" & Adodc1.Recordset.Fields(1).Value & "'"
  jj2 = "二='" & Adodc1.Recordset.Fields(1).Value & "'"
  jj3 = "三='" & Adodc1.Recordset.Fields(1).Value & "'"
  jj4 = "四='" & Adodc1.Recordset.Fields(1).Value & "'"
  jj5 = "五='" & Adodc1.Recordset.Fields(1).Value & "'"
  jj6 = "六='" & Adodc1.Recordset.Fields(1).Value & "'"
  jj7 = "七='" & Adodc1.Recordset.Fields(1).Value & "'"
  jj8 = "特='" & Adodc1.Recordset.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
  ProgressBar1.Value = step
  Adodc1.Recordset.MoveNext
Loop
step = 0

'删空 各期位置表 准备赋新值
If Adodc4.Recordset.RecordCount <> 0 Then
Label1.Caption = "开始删空 各期位置表 准备赋新值，请耐心等待......"
DoEvents
ProgressBar1.max = Adodc4.Recordset.RecordCount
ProgressBar1.Min = 0

Adodc4.Recordset.MoveFirst
  Do While Not Adodc4.Recordset.EOF
    step = step + 1
    Adodc4.Recordset.Delete adAffectCurrent
    ProgressBar1.Value = step
    Adodc4.Recordset.MoveNext
    Loop
End If
step = 0

Dim i As Integer

'对各期频次表赋值++++++++++++++++++++++++++++++++++++++++++++++
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 22
    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

End If
End Sub



Private Sub Form_Load()
'Set Picture1.Container = Frame1
Adodc1.Refresh
Adodc3.Refresh
Adodc4.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


End Sub