冷热追踪.txt

用于分析彩票排列3的一组源码。共5个

'==========================================================
'             冷  热   追   踪
'==========================================================
CpParam.Add "冷热期数",1,"{1}{2}{3}{4}{5}"'用户设置参数
CpParam.AddBtn "OnButton", "分段设置"
set CpSec = CreateObject("BoaoHbsActive.CpSec")
TmpFile =  "Module\"&CpData.Name&"_冷热追踪.tmp"
Set fso = CreateObject("Scripting.FileSystemObject")
  If (fso.FileExists(TmpFile)) Then
    CpSec.Load(TmpFile)
  Else
    CpSec.Add "01-05=01 02 03 04 05"
    CpSec.Add "06-10=06 07 08 09 10"
    CpSec.Add "11-15=11 12 13 14 15"
    CpSec.Add "16-20=16 17 18 19 20"
    CpSec.Add "21-25=21 22 23 24 25"
    CpSec.Add "26-30=26 27 28 29 30"
    CpSec.Add "31-35=31 32 33 34 35"
    CpSec.Add "36-37=36 37"
  End If
Function OnButton
  If CpDlg.Sec(CpSec, CpData.MinCode, CpData.CodeCount) Then        
    CpSec.Save TmpFile  
    OnButton = True
  Else
    OnButton = False
  End If  	
End Function

Function Main
  '===============申明或定义变量=============
  CpRowCount = CpData.RowCount  '开奖期数
  CpColCount = CpData.ColCount   '开奖号码个数
  CpMaxCode = CpData.MaxCode    '最大号码
  CpMinCode = CpData.MinCode      '最小号码
  CpCodeCount = CpData.CodeCount '号码数量

  Pub_QS = CInt(CpParam.Value("冷热期数"))    
  If Pub_QS=0 Then
    Pub_QS=99999
  End If
  '=================建表=================
  CpAna.AddField "期号",8
  CpAna.AddField "开奖号码",CpColCount*3
  CpAna.AddField "分区形态",20

  For i = 0 to CpSec.Count-1    
    CpAna.AddField CpSec.Name(i),6
  Next
  CpAna.AddField "段数",8
  For i = 0 to CpSec.Count-1    
    CpAna.AddField CpSec.Name(i)&"列表",50
  Next

  CpAna.RowCount = CpRowCount
  CpAna.CreateTable()


  '==============算法主体============================  
  set CpSec0 = CreateObject("BoaoHbsActive.CpSec")
  ReDim sum(CpCodeCount)'在Pub_QS期内的开奖次数
  ReDim SortCodes(CpCodeCount)'根据sum排序后的开奖号码序列
  ReDim Codes(CpColCount)'开奖数据

  For row = 0 to CpRowCount-1
      '期号 开奖号码
      CpAna.Cell(row, "期号") = CpData.Seq(row)
      CpAna.Cell(row, "开奖号码") = CpData.CodeStr(row)

      For col = 0 to CpColCount-1
        Codes(col) = CpData.Code(row,col)
      Next

      '排序
      Sort sum, SortCodes'根据开奖次数排序号码，SortCodes为排序好的号码序列  

      DS = 0
      XT = ""
      
      For i = 0 to CpSec.Count-1
        str0 = ""
        For j = 0  to CpCodeCount-1
          If CpSec.IsMember(CInt(i), j+CpMinCode) Then
              str0 = str0 & SortCodes(j)  & "  "  
          End If
        Next
        CpAna.Cell(row, CpSec.Name(i)&"列表") = str0
        CpSec0.Clear
        CpSec0.Add "aa="&str0'新的号码段
        cnt = CpSec0.MemberCount(0,Codes)
        CpAna.Cell(row, CStr(CpSec.Name(i))) = cnt
        CpAna.Color(row, CStr(CpSec.Name(i))) = CpColor.IndexOf(cnt)
        If cnt > 0 Then
          DS = DS+1
        End If
        XT = XT&cnt
      Next      
      CpAna.Cell(row, "分区形态") = XT
      CpAna.Cell(row, "段数") = DS
      
    
    if row >= Pub_QS Then
      '减去前Pub_QS期的开奖次数
      For col = 0 to CpColCount - 1  
        i = CpData.Code(row-Pub_QS, col)-CpMinCode
        sum(i) = sum(i) - 1    
      Next
    End If
  
    For col = 0 to CpColCount - 1
      i = CpData.Code(row, col)-CpMinCode
      sum(i) = sum(i) + 1
    Next
  Next
End Function

'==============辅助函数============================
'根据开奖次数排序号码，Num为排序好的号码序列
Function Sort(ByVal Sum(), ByRef Num())
  CpMaxCode = CpData.MaxCode
  CpMinCode = CpData.MinCode
  CpCodeCount = CpData.CodeCount'号码个数
  ReDim aa(CpCodeCount)
  For i = 0 to CpCodeCount-1
    n = -1
    max = -1
    For j = 0 to CpCodeCount-1
      If aa(j) <> -1 And Sum(j) > max Then
        max = Sum(j)
        n = j
      End If
    Next
    Num(i) = CpMinCode+n
    aa(n) = -1
  Next
End Function