intevalanly.frm

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

         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.Frame Frame2 
      Height          =   3755
      Left            =   0
      TabIndex        =   5
      Top             =   3000
      Width           =   2600
      Begin VB.PictureBox Picture2 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         ForeColor       =   &H80000008&
         Height          =   7000
         Left            =   0
         ScaleHeight     =   6975
         ScaleWidth      =   2565
         TabIndex        =   6
         Top             =   0
         Width           =   2600
      End
   End
   Begin VB.Frame Frame1 
      Height          =   2655
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   9255
      Begin VB.PictureBox Picture1 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         ForeColor       =   &H80000008&
         Height          =   32768
         Left            =   0
         ScaleHeight     =   32745
         ScaleWidth      =   32745
         TabIndex        =   4
         Top             =   0
         Width           =   32768
      End
   End
   Begin ActiveCandy.CandyCommand CandyCommand1 
      Height          =   375
      Left            =   8640
      TabIndex        =   2
      Top             =   3000
      Width           =   855
      _ExtentX        =   1508
      _ExtentY        =   661
      BackPicture     =   1
      Caption         =   "号码间隔"
      ForeColor       =   255
      FontName        =   "宋体"
      FontSize        =   9
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      LargeChange     =   100
      Left            =   0
      Max             =   100
      SmallChange     =   100
      TabIndex        =   1
      Top             =   2640
      Width           =   9495
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   2655
      LargeChange     =   100
      Left            =   9240
      SmallChange     =   100
      TabIndex        =   0
      Top             =   0
      Width           =   255
   End
   Begin VB.VScrollBar VScroll2 
      Height          =   3765
      LargeChange     =   50
      Left            =   2600
      SmallChange     =   50
      TabIndex        =   7
      Top             =   3000
      Width           =   200
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid2 
      Bindings        =   "intevalanly.frx":08E0
      Height          =   3255
      Left            =   5160
      TabIndex        =   15
      Top             =   3000
      Width           =   3375
      _ExtentX        =   5953
      _ExtentY        =   5741
      _Version        =   393216
      Cols            =   9
      ScrollBars      =   2
      _NumberOfBands  =   1
      _Band(0).Cols   =   9
      _Band(0)._NumMapCols=   8
      _Band(0)._MapCol(0)._Name=   "间隔组"
      _Band(0)._MapCol(0)._RSIndex=   0
      _Band(0)._MapCol(1)._Name=   "1"
      _Band(0)._MapCol(1)._RSIndex=   1
      _Band(0)._MapCol(1)._Alignment=   7
      _Band(0)._MapCol(2)._Name=   "2"
      _Band(0)._MapCol(2)._RSIndex=   2
      _Band(0)._MapCol(2)._Alignment=   7
      _Band(0)._MapCol(3)._Name=   "3"
      _Band(0)._MapCol(3)._RSIndex=   3
      _Band(0)._MapCol(3)._Alignment=   7
      _Band(0)._MapCol(4)._Name=   "4"
      _Band(0)._MapCol(4)._RSIndex=   4
      _Band(0)._MapCol(4)._Alignment=   7
      _Band(0)._MapCol(5)._Name=   "5"
      _Band(0)._MapCol(5)._RSIndex=   5
      _Band(0)._MapCol(5)._Alignment=   7
      _Band(0)._MapCol(6)._Name=   "6"
      _Band(0)._MapCol(6)._RSIndex=   6
      _Band(0)._MapCol(6)._Alignment=   7
      _Band(0)._MapCol(7)._Name=   "7"
      _Band(0)._MapCol(7)._RSIndex=   7
      _Band(0)._MapCol(7)._Alignment=   7
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   5160
      TabIndex        =   13
      Top             =   6360
      Visible         =   0   'False
      Width           =   4335
   End
End
Attribute VB_Name = "intevalanly"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
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 CandyCommand1_Click()
'号码间隔
Dim slian As Integer
Dim tlian As Integer
Dim mlian As Integer
Dim temp As Long
slian = 0
tlian = 0
mlian = -2

Screen.MousePointer = 11
DoEvents
Dim i As Integer
Dim qurnumber As String
For i = 1 To 32
qurnumber = Right(Str(i + 100), 2)
 
 If (i - 1) * 900 + 50 > Picture1.Width Then
   Picture1.Width = Picture1.Width + 900
   HScroll1.max = Picture1.Width - Frame1.Width
 End If
 
Picture1.CurrentX = (i - 1) * 900 + 50
Picture1.CurrentY = 0
Picture1.FontBold = False
Picture1.ForeColor = QBColor(0)
Picture1.Print qurnumber
Picture1.CurrentX = (i - 1) * 900 + 50
Picture1.CurrentY = 100
Picture1.Print "_________"

intevaltest.Adodc2.Recordset.Filter = "号码='" & Trim(qurnumber) & "'"
intevaltest.Adodc2.Recordset.MoveFirst
Do While Not intevaltest.Adodc2.Recordset.EOF
If mlian = intevaltest.Adodc2.Recordset.Fields(2).Value Then
slian = slian + 1
tlian = tlian + slian
End If

  Picture1.CurrentX = (i - 1) * 900 + 50
  If intevaltest.Adodc2.Recordset.AbsolutePosition * 200 + 200 > Picture1.Height Then
  Picture1.Height = Picture1.Height + 500
  VScroll1.max = Picture1.Height - Frame1.Height
  End If
  Picture1.CurrentY = intevaltest.Adodc2.Recordset.AbsolutePosition * 200 + 200
  temp = intevaltest.Adodc2.Recordset.AbsolutePosition * 200 + 200
  Picture1.FontBold = True
  Picture1.ForeColor = QBColor(12)
  Picture1.Print intevaltest.Adodc2.Recordset.Fields(2).Value
  mlian = intevaltest.Adodc2.Recordset.Fields(2).Value
  intevaltest.Adodc2.Recordset.MoveNext
Loop
If slian <> 0 Then
Picture1.CurrentX = (i - 1) * 900 + 50
Picture1.CurrentY = temp + 200
Picture1.Print "---"
Picture1.CurrentX = (i - 1) * 900 + 50
Picture1.CurrentY = temp + 300
Picture1.Print slian
End If
mlian = -2
slian = 0

'If totalform Then '汇总间隔窗口是否存在
' intevaltest.Adodc2.Recordset.MoveFirst
'  Do While Not intevaltest.Adodc2.Recordset.EOF
'    totalanalyses.hhfcevn.rscommand1.MoveFirst
'    totalanalyses.hhfcevn.rscommand1.Find "号码='" & Trim(qurnumber) & "' and " & "间隔组=" & intevaltest.Adodc2.Recordset.Fields(2).Value
'
'    If totalanalyses.hhfcevn.rscommand1.EOF Then
'      MsgBox "数据库存在错误，请关闭所有窗口重新运行本程序，重新收集数据。", vbOKOnly, "提示"
'      Exit Do
'    Else
'      Picture1.CurrentX = (i - 1) * 900 + 400
'      If intevaltest.Adodc2.Recordset.AbsolutePosition * 200 + 200 > Picture1.Height Then
'       Picture1.Height = Picture1.Height + 500
'      Picture1.Height = Picture1.Height + 500
'      End If
'      Picture1.CurrentY = intevaltest.Adodc2.Recordset.AbsolutePosition * 200 + 200
'      Picture1.FontBold = True
'      Picture1.ForeColor = QBColor(6)
'      Picture1.Print totalanalyses.hhfcevn.rscommand1.Fields(5).Value
'      intevaltest.Adodc2.Recordset.MoveNext
'    End If
'  Loop
'End If
 
intevaltest.Adodc2.Recordset.MoveFirst
Do While Not intevaltest.Adodc2.Recordset.EOF
    hhfcevn.rsCommand1.MoveFirst
       
    hhfcevn.rsCommand1.Filter = "号码='" & Trim(qurnumber) & "'and " & "间隔组=" & intevaltest.Adodc2.Recordset.Fields(2).Value

    If hhfcevn.rsCommand1.EOF Then
      MsgBox "数据库存在错误，请关闭所有窗口重新运行本程序，重新收集数据。", vbOKOnly, "提示"
      Exit Do
    Else
      Picture1.CurrentX = (i - 1) * 900 + 400
      If intevaltest.Adodc2.Recordset.AbsolutePosition * 200 + 200 > Picture1.Height Then
            Picture1.Height = Picture1.Height + 500
            VScroll1.max = Picture1.Height - Frame1.Height
      End If
      Picture1.CurrentY = intevaltest.Adodc2.Recordset.AbsolutePosition * 200 + 200
      Picture1.FontBold = True
      Picture1.ForeColor = QBColor(6)
      Picture1.Print Str(Int((hhfcevn.rsCommand1.Fields(3).Value) * 100)) + "%"
      intevaltest.Adodc2.Recordset.MoveNext
    End If
  Loop

Next i
Screen.MousePointer = 0
'intevaltest.Adodc2.Recordset.Filter = adFilterNone
Picture1.CurrentX = (33 - 1) * 900 + 50
Picture1.CurrentY = 0
Picture1.Print "连续间隔总和：  " & tlian

CandyCommand1.Enabled = False
End Sub

Private Sub CandyCommand2_Click()
'间隔平均
Picture2.Font.Bold = False
Picture2.ForeColor = QBColor(0)
Picture2.CurrentX = 50
Picture2.CurrentY = 50
Picture2.Print "间隔组" + Space(4) + "总量" + Space(4) + "平均每期"
Picture2.CurrentX = 0
Picture2.CurrentY = 150
Picture2.Print "______________________________________"
Picture2.Font.Bold = True
Picture2.ForeColor = QBColor(12)

  
    Adodc2.Recordset.MoveFirst
    Do While Not Adodc2.Recordset.EOF
    Picture2.CurrentX = 50
      Picture2.CurrentY = ((Adodc2.Recordset.AbsolutePosition + 1) * 250) + 100
      Picture2.Print Adodc2.Recordset.Fields(0).Value & Space(10 - Len(Str(Adodc2.Recordset.Fields(0).Value))) & Adodc2.Recordset.Fields(1).Value _
      & Space(10 - Len(Str(Adodc2.Recordset.Fields(1).Value))) & Int((Adodc2.Recordset.Fields(1).Value / hhfcevn.rshhfcreport.RecordCount) * 10) / 10
      Adodc2.Recordset.MoveNext
    Loop
End Sub

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