精 彩 论 坛已经更名为百强频道,迁新地址www.bqpd.cn

亲爱的朋友,首先为给您带来的不便深表歉意,现因发展的需要,精彩论坛迁到新的地址http://www.bqpd.cn,还望您一如既往地支持精彩论坛,谢谢
精 彩 论 坛已经更名为百强频道,迁新地址www.bqpd.cn

论坛因发展的需要现已经迁址www.bqpd.cn,等待您的到来。谢谢


    [分享]间 隔 走 势-图-(通用版本)

    分享
    avatar
    一品明灯
    Admin

    帖子数 : 292
    积分 : 720
    威望 : 4
    注册日期 : 10-03-02
    年龄 : 8

    普通 [分享]间 隔 走 势-图-(通用版本)

    帖子 由 一品明灯 于 2010-03-08, 08:36

    [分享]间 隔 走 势-图-(通用版本)

    '===============================================================
    ' 间 隔 走 势-图--数字彩与乐透通用
    ' by-chinamen668 20061219
    '取代原号码走势横向间距最后一个没判断
    '横处可以输入+5或-5或5
    '横处输入+5,则大于横距数字的加底色
    '横处输入-5,则小于于横距数字的加底色
    '横处输入5,则等于横距数字的加底色
    '隔处就是开奖期号隔多少期来分析,可以正负数,
    '负的时候把历史期数全按此隔来分析
    '隔处输入 5,则分区(分基号)加底色.注意前面是空格
    '分段内可以自己更改,格式遵循"1段= 0 2 3"
    '可以少不可多及重复数字,出现意外自行再分段
    '===============================================================
    CpParam.Add "横",5''用户设置参数可以输入+5或-5或05或5
    CpParam.Add "隔",0
    CpParam.AddBtn "OnButton", "分段"
    CpParam.AddBtn "cmdSJ", "随机"
    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 "1段= 0 1 2 3 4"
    CpSec.Add "2段= 5 6 7 8 9"
    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 cmdSJ
    N = CpData.CodeCount\CpSec.Count
    M = CpData.CodeCount Mod CpSec.Count
    cc = 0
    MaxSecLB = ""
    C = 0
    While C < M
    x = CInt(CpSec.Count * Rnd)
    If x = 0 Then x = 1
    If x < 10 Then x = "0" & x
    If InStr(MaxSecLB, x) < 1 Then
    MaxSecLB = MaxSecLB & x & " "
    C = C + 1
    End If
    Wend
    CCC = CpSec.Count - 1
    CpSec.Clear
    For i = 0 To CCC
    SecNum = i + 1
    If SecNum < 10 Then SecNum = "0" & SecNum
    If M > 0 And InStr(MaxSecLB, SecNum) Then
    K = N + 1
    Else
    K = N
    End If
    C = 0
    SecLB = ""
    While C < K
    x = CpData.MinCode + CInt(CpData.MaxCode * Rnd)
    If x > CpData.MaxCode Then x = CpData.MaxCode
    If x < 10 and CpData.MaxCode>10 Then x = "0" & x
    If InStr(LB, x) < 1 Then
    SecLB = SecLB& " "& x
    LB = LB & SecLB
    C = C + 1
    End If
    Wend
    CpSec.Add i+1 & "段=" & SecLB
    Next
    CpSec.Save TmpFile
    cmdSJ = True
    End Function



    Function Main
    '===============申明或定义变量=============
    CpRowCount = CpData.RowCount '开奖期数
    CpColCount = CpData.ColCount '开奖号码个数
    CpMaxCode = CpData.MaxCode '最大号码
    CpMinCode = CpData.MinCode '最小号码
    CpCodeCount = CpData.CodeCount '号码数量
    '先定义分段号码
    Redim Pub_GW(CpCodeCount)
    FdHm=""
    For i = 0 To CpSec.Count - 1
    FdHm= CpSec.sec(cint(i))
    For j = 0 to CpCodeCount
    a=InStr(FdHm," ")
    If a=0 then
    ub_GW(Pub_GS)=FdHm
    ub_GS=Pub_GS+1
    exit for
    ElseIf a>1 then
    ub_GW(Pub_GS)=Left(FdHm,a-1)
    ub_GS=Pub_GS+1
    End If
    b=Len(FdHm)
    FdHm=Right(FdHm,b-a)
    Next
    Next



    ub_PdDx=Left(CpParam.Value("横"),1)
    ub_HxJj=abs(CInt(CpParam.Value("横")))+1
    avatar
    一品明灯
    Admin

    帖子数 : 292
    积分 : 720
    威望 : 4
    注册日期 : 10-03-02
    年龄 : 8

    普通 回复: [分享]间 隔 走 势-图-(通用版本)

    帖子 由 一品明灯 于 2010-03-08, 08:37

    '接上贴

    ub_FqYs=Left(CpParam.Value("隔"),1)
    a=abs(CInt(CpParam.Value("隔")))
    if CInt(CpParam.Value("隔"))>0 then
    D=CpRowCount mod (a+1)
    hanshu=(CpRowCount-PD+a)\(a+1)
    xuanzhe=0
    else
    PD=(CpRowCount+1) mod (a+1)
    hanshu=CpRowCount-PD
    xuanzhe=a
    end if
    '先定义是否按大小来排序基号
    Redim Hm(CpRowCount,CpCodeCount)
    For row = 0 to CpRowCount - 1
    For Col=0 to CpColCount-1
    Hm(row,Col)=CpData.Code(Row,Col)
    Next
    If CpMaxCode>10 then '非数字彩大小排序号码
    For i=0 to CpColCount-2
    For j=i+1 to CpColCount-1
    if Hm(row,i)>Hm(row,j) then
    k=Hm(row,i)
    Hm(row,i)=Hm(row,j)
    HM(row,j)=k
    end if
    Next
    Next
    End If
    Next
    '=================建表=================
    CpAna.AddField "期号", 8
    CpAna.AddField "开奖号码", CpColCount*3
    For col=1 to CpColCount
    if CpData.MaxCode>10 Then col=""
    For i = 0 to Pub_GS-1
    CpAna.AddField col&ub_GW(i),2
    Next
    if CpData.MaxCode>10 Then exit for
    Next
    CpAna.RowCount =hanshu
    CpAna.CreateTable()



    '==============算法主体============================
    ReDim JianGe(CpColCount,CpMaxCode)'存间隔开奖号
    ReDim JJGe(CpColCount+1)
    row0=0
    JJGE(0)=0



    For s=0 to xuanzhe
    For row= s+pd to CpRowCount -1 step a+1
    hz=0
    DS=0
    TL0=0
    jjgs=0'多少个横间距
    FBZT=""
    For col= 0 To CpColCount - 1
    For i = 0 To CpMaxCode
    JianGe(col,i) = 0
    next
    Next
    CpAna.Cell(row0, "期号") = CpData.Seq(row)
    CpAna.Cell(row0, "开奖号码") = CpData.CodeStr(row)
    CpAna.Color(row0, "期号") = CpColor.IndexOf((s+1) mod 4 )
    For col= 0 To CpColCount - 1
    code = Hm(row,Col)
    JianGe(col,code) = 1
    JJGE(col+1)= CpMinCode
    Next
    '把开奖号填入走势图
    jj=0
    '数字彩
    For col=0 to CpColCount-1
    if CpMinCode>0 Then exit for
    For i = 0 to Pub_GS-1
    jj=jj+1
    code=Pub_GW(i)
    If JianGe(col,code) = 1 then
    CpAna.Cell(row0, col+1&ub_GW(i)) =code
    jjgs=jjgs+1
    JJGE(jjgs)=JJ
    Elseif ub_FqYs=" " then'隔前如果输入" "空格则分区加色
    ys=col mod 2
    if ys=1 then CpAna.BKCOLOR(row0, cint(jj+1))=VbWhite
    End if
    Next
    Next
    '乐透型
    For i = 0 to Pub_GS-1
    if CpMinCode=0 Then exit for
    jj=jj+1
    code=Pub_GW(i)
    For col=0 to CpColCount-1
    If JianGe(col,code) = 1 then
    CpAna.Cell(row0, Pub_GW(i)&"") =code
    jjgs=jjgs+1
    JJGE(jjgs)=JJ
    Elseif ub_FqYs=" " then'隔前如果输入" "空格则分区加色
    ys=CpSec.IndexOf(Code) mod 2
    if ys=1 then CpAna.BKCOLOR(row0, cint(jj+1))=VbWhite
    End if
    Next
    Next
    JJGE(jjgs+1)= jj+1
    '对符合要求的横距加灰色底
    For col=1 To jjgs +1
    If Pub_PdDx="-" then'小于横距
    if JJGE(col)-JJGE(col-1) < Pub_HxJj then
    For i = JJGE(col-1)+1 to JJGE(col)-1
    CpAna.BKCOLOR(row0, cint(i+1))=CpColor.ToRGB(220,220,220)
    Next
    end if
    ElseIf Pub_PdDx="+" then'大于横距
    if JJGE(col)-JJGE(col-1) > Pub_HxJj then
    For i = JJGE(col-1)+1 to JJGE(col)-1
    CpAna.BKCOLOR(row0, cint(i+1))=CpColor.ToRGB(220,220,220)
    Next
    end if
    Else'等于横距
    if JJGE(col)-JJGE(col-1) = Pub_HxJj then
    For i = JJGE(col-1)+1 to JJGE(col)-1
    CpAna.BKCOLOR(row0, cint(i+1))=CpColor.ToRGB(220,220,220)
    Next
    end if
    End if
    Next
    row0=row0+1
    Next
    Next



    End Function

      目前的日期/时间是2018-04-25, 01:59