choice.frm

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

      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "自选"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   180
         Left            =   4200
         TabIndex        =   10
         Top             =   300
         Width           =   405
      End
   End
   Begin ActiveCandy.CandyCommand CandyCommand4 
      Height          =   495
      Left            =   3480
      TabIndex        =   39
      Top             =   4680
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   873
      BackPicture     =   1
      Caption         =   "全敏感号码"
      ForeColor       =   255
      FontName        =   "楷体_GB2312"
      FontSize        =   10.5
      FontBold        =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "楷体_GB2312"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label2 
      Caption         =   "个"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4880
      TabIndex        =   8
      Top             =   3600
      Width           =   255
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   180
      Left            =   3000
      TabIndex        =   6
      Top             =   4080
      Width           =   120
   End
End
Attribute VB_Name = "choice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
'Dim zhsingler() As String
Dim zhcount(1 To 1, 1 To 7) As String
Dim chcount1() As String
Dim chcount2() As String
Dim k As Integer
Dim c As Integer
Dim i As Integer
Dim j As Integer
Dim o As Integer
Dim p As Integer
Dim ns As String
Dim equarl As String
Dim coll As Integer
Dim row1 As Integer
Dim col1 As Integer
Dim jumpflag As Boolean
'Dim rsdupli As ADODB.Recordset
Dim minval As String
Dim maxval As String
Dim jqs As String
Dim iffirst As Boolean
Dim howmany As Integer '全间隔赋值数
Dim mhowmany As Integer '全敏感赋值数
Dim nosame(1 To 1, 1 To 8) As String '全间隔无重复
Dim nuchoice(1 To 1, 1 To 8) As String '全敏感选号码
Dim same As Boolean
Dim iii As Integer
Dim bmt() As Variant
Dim everytotal As Integer '各期和
Dim every As Integer
Dim tempevery(1 To 1, 1 To 7) As String
Dim zhushu As Long

Dim mtot As Integer
Dim jtot As Integer
Dim tot As Integer
Dim canchoice(1 To 32, 1 To 1) As String

Private Sub CandyCommand1_Click()
'敏感数字
Dim mgmsg As Integer
mgmsg = MsgBox("如果是从 全间隔 和 全敏感 转换而来，请先按<重来>键，否则将产生错误。可以开始吗？", vbOKCancel, "提示")
If mgmsg = vbOK Then
  Dim ii As Integer
  Dim jj As Integer
  ii = 1
  jj = 0
  j = 2
  Dim inttemp As Integer
  '删空 位置频次号码表
  If Adodc1.Recordset.RecordCount <> 0 Then
    Adodc1.Recordset.MoveFirst
    Do While Not Adodc1.Recordset.EOF
      Adodc1.Recordset.Delete adAffectCurrent
      Adodc1.Recordset.Update
      Adodc1.Recordset.MoveNext
    Loop
  End If
  
  If hhfcevn.rsplacefrequcy.State = adStateClosed Then
  hhfcevn.rsplacefrequcy.Open
  End If
  hhfcevn.rsplacefrequcy.Requery
  
  If hhfcevn.rshhfcreport.State = adStateClosed Then
  hhfcevn.rshhfcreport.Open
  End If
  hhfcevn.rshhfcreport.Requery
  
  Dim topqu2 As String
  hhfcevn.rshhfcreport.MoveFirst
  topqu2 = hhfcevn.rshhfcreport.Fields(0).Value
  Do While Not hhfcevn.rshhfcreport.EOF
    If Val(hhfcevn.rshhfcreport.Fields(0).Value) > Val(topqu2) Then
      topqu2 = hhfcevn.rshhfcreport.Fields(0).Value
    End If
  hhfcevn.rshhfcreport.MoveNext
  Loop
  
  For i = 0 To 15
  Picture1.CurrentX = i * 1000
  Picture1.CurrentY = 0
  Picture1.Print i & "间隔"
  Picture1.CurrentX = i * 1000
  Picture1.CurrentY = 200
  Picture1.Print "------"
  Next i
  
  hhfcevn.rsplacefrequcy.MoveFirst
  inttemp = hhfcevn.rsplacefrequcy.Fields(2).Value
  
  Adodc1.Recordset.AddNew
  Adodc1.Recordset.Fields(0).Value = "0间隔"
  
  Do While Not hhfcevn.rsplacefrequcy.EOF
  If inttemp <> hhfcevn.rsplacefrequcy.Fields(2).Value And hhfcevn.rsplacefrequcy.Fields(2).Value <> -1 Then
    j = 2
    
    If hhfcevn.rsplacefrequcy.Fields(2).Value <> 0 Then
      Adodc1.Recordset.Update
      Adodc1.Recordset.Resync adAffectCurrent, adResyncAllValues
      Adodc1.Recordset.AddNew
      Adodc1.Recordset.Fields(0).Value = Trim(Str(hhfcevn.rsplacefrequcy.Fields(2).Value)) + "间隔"
      ii = 1
    End If
  End If
  inttemp = hhfcevn.rsplacefrequcy.Fields(2).Value
  
  If hhfcevn.rsplacefrequcy.Fields(2).Value <> -1 And hhfcevn.rsplacefrequcy.Fields(2).Value <> -2 Then
    hhfcevn.rshhfcreport.MoveLast
    hhfcevn.rshhfcreport.Find "期数='" & Trim(Str(Val(topqu2) - hhfcevn.rsplacefrequcy.Fields(2).Value)) & "'", , adSearchBackward
    
    If hhfcevn.rshhfcreport.EOF Then
    MsgBox "数据有误，请关闭所有窗口，重新执行程序一", vbOKOnly, "提示"
    Exit Sub
    Else
        
      intevalanly.Adodc4.Recordset.MoveLast
      intevalanly.Adodc4.Recordset.Find "期数='" & Trim(topqu2) & "'", , adSearchBackward
      If intevalanly.Adodc4.Recordset.EOF Then
         MsgBox "数据有误，请关闭所有窗口，重新执行程序二", vbOKOnly, "提示"
         Exit Sub
      Else
         
         Picture1.ForeColor = QBColor(12)
         Picture1.CurrentX = hhfcevn.rsplacefrequcy.Fields(2).Value * 1000
         Picture1.CurrentY = j * 400
         j = j + 1
         Picture1.Print hhfcevn.rsplacefrequcy.Fields(0).Value
         Picture1.ForeColor = QBColor(0)
         
         If intevalanly.Adodc4.Recordset.Fields(hhfcevn.rsplacefrequcy.Fields(1).Value).Value <> 0 Then
            hhfcevn.rsfrequency.Filter = "频次=" & intevalanly.Adodc4.Recordset.Fields(hhfcevn.rsplacefrequcy.Fields(1).Value).Value
            If hhfcevn.rsfrequency.RecordCount = 0 Then
              MsgBox "数据有误，请关闭所有窗口，重新执行程序三", vbOKOnly, "提示"
              Exit Sub
            Else
              hhfcevn.rsfrequency.MoveFirst
              Do While Not hhfcevn.rsfrequency.EOF
                 For i = 1 To 8
                     If hhfcevn.rsfrequency.Fields(0).Value = hhfcevn.rshhfcreport.Fields(i).Value Then
                       If ii <= 32 Then
                         Adodc1.Recordset.Fields(ii).Value = hhfcevn.rsfrequency.Fields(0).Value
                       End If
                       
                       Picture1.CurrentX = hhfcevn.rsplacefrequcy.Fields(2).Value * 1000
                       Picture1.CurrentY = j * 400
                       DoEvents
                       j = j + 1
                       Picture1.Print hhfcevn.rsfrequency.Fields(0).Value
                       
                       ii = ii + 1
                       jj = jj + 1
                     End If
                 Next i
               hhfcevn.rsfrequency.MoveNext
               Loop
               
               If ii <= 32 Then
                 Adodc1.Recordset.Fields(ii).Value = Trim(Str(jj))
               End If
               ii = ii + 1
               jj = 0
               
             End If
          End If
        End If
      End If
    End If
  hhfcevn.rsplacefrequcy.MoveNext
  hhfcevn.rsfrequency.Filter = adFilterNone
  Loop
  
  Adodc1.Recordset.Update
  Adodc1.Recordset.Resync adAffectCurrent, adResyncAllValues
  
  Combo1.Enabled = True
  Combo2.Enabled = True
  Combo3.Enabled = True
  
  intevalanly.Adodc2.Recordset.MoveFirst
  intevalanly.Adodc2.Recordset.Filter = "间隔总量<>0"
  Do While Not intevalanly.Adodc2.Recordset.EOF
  Combo1.List(intevalanly.Adodc2.Recordset.AbsolutePosition - 1) = Trim(Str(intevalanly.Adodc2.Recordset.Fields(0).Value)) + "间隔"
  'Combo5.List(intevalanly.Adodc2.Recordset.AbsolutePosition - 1) = Trim(Str(intevalanly.Adodc2.Recordset.Fields(0).Value)) + "间隔"
  intevalanly.Adodc2.Recordset.MoveNext
  Loop
  intevalanly.Adodc2.Recordset.Filter = adFilterNone
End If
End Sub

Private Sub CandyCommand2_Click()
'号码组合
Load zuhenum
zuhenum.Show
End Sub

Private Sub CandyCommand3_Click()
'全间隔号码
Dim qjgmsg As Integer
qjgmsg = MsgBox("如果是从 全间隔 和 全敏感 转换而来，请先按<重来>键，否则将产生错误。可以开始吗？", vbOKCancel, "提示")
If qjgmsg = vbOK Then
  Frame3.Visible = True
  Frame3.Width = 5530
  Frame3.Height = 1455
  Frame5.Visible = False
  CandyCommand3.Enabled = False
  CandyCommand4.Enabled = True
  
  Combo5.Enabled = True
  Combo6.Enabled = True
  
  intevalanly.Adodc2.Recordset.MoveFirst
  intevalanly.Adodc2.Recordset.Filter = "间隔总量<>0"
  Do While Not intevalanly.Adodc2.Recordset.EOF
    'Combo1.List(intevalanly.Adodc2.Recordset.AbsolutePosition - 1) = Trim(Str(intevalanly.Adodc2.Recordset.Fields(0).Value)) + "间隔"
    Combo5.List(intevalanly.Adodc2.Recordset.AbsolutePosition - 1) = Trim(Str(intevalanly.Adodc2.Recordset.Fields(0).Value)) + "间隔"
    intevalanly.Adodc2.Recordset.MoveNext
  Loop
  intevalanly.Adodc2.Recordset.Filter = adFilterNone
End If
End Sub

Private Sub CandyCommand4_Click()
'全敏感号码
Dim qmgmsg As Integer
qmgmsg = MsgBox("如果是从 全间隔 和 全敏感 转换而来，请先按<重来>键，否则将产生错误。可以开始吗？", vbOKCancel, "提示")
If qmgmsg = vbOK Then
  Frame5.Visible = True
  Frame3.Visible = False
  CandyCommand4.Enabled = False
  CandyCommand3.Enabled = True
  
  Combo9.Enabled = True
  Combo8.Enabled = True
  
  intevalanly.Adodc2.Recordset.MoveFirst
  intevalanly.Adodc2.Recordset.Filter = "间隔总量<>0"
  Do While Not intevalanly.Adodc2.Recordset.EOF
    'Combo1.List(intevalanly.Adodc2.Recordset.AbsolutePosition - 1) = Trim(Str(intevalanly.Adodc2.Recordset.Fields(0).Value)) + "间隔"
    Combo9.List(intevalanly.Adodc2.Recordset.AbsolutePosition - 1) = Trim(Str(intevalanly.Adodc2.Recordset.Fields(0).Value)) + "间隔"
    intevalanly.Adodc2.Recordset.MoveNext
  Loop
  intevalanly.Adodc2.Recordset.Filter = adFilterNone
End If
End Sub

Private Sub Combo1_Click()
mhowmany = 0
If tot = 7 Then

  Combo1.Enabled = False
  Combo2.Enabled = False
  Combo3.Enabled = False
  Exit Sub
End If

Combo2.Visible = True
Combo2.Enabled = True

Adodc1.Recordset.MoveFirst
Adodc1.Recordset.Find "间隔组='" & Trim(Combo1.Text) & "'", , adSearchForward, 1

For i = 1 To 20
  If Len(Adodc1.Recordset.Fields(i).Value) = 2 Then
    mhowmany = mhowmany + 1
  End If
Next i

If mhowmany = 0 Then
  Combo2.Enabled = False
End If

intevalanly.Adodc2.Recordset.MoveFirst
If Len(Combo1.Text) = 3 Then
  intevalanly.Adodc2.Recordset.Find "间隔组=" & Val(Left(Trim(Combo1.Text), 1)), , adSearchForward, 1
Else
  intevalanly.Adodc2.Recordset.Find "间隔组=" & Val(Left(Trim(Combo1.Text), 2)), , adSearchForward, 1
End If

Label1.Caption = "平均每期有" & Int((intevalanly.Adodc2.Recordset.Fields(1).Value / hhfcevn.rshhfcreport.RecordCount) * 10) / 10 & "个，您打算选"
Combo2.Left = Label1.Left + Label1.Width
Label2.Left = Combo2.Left + Combo2.Width

j = 0
For i = 1 To 32
  If Len(Adodc1.Recordset.Fields(i).Value) = 2 Then
    j = j + 1
  End If
Next i

If j > 7 Or j >= 7 - tot Then
j = 7 - tot
End If
    
Combo2.Clear

For i = 1 To j
Combo2.List(i - 1) = i
Next i
End Sub
Private Sub Combo2_Click()
Combo3.Enabled = True