[分享]间隔走势图（乐透版）

[分享]间隔走势图（乐透版）

'==========================================================
' 间 隔 走 势 图
' by chinamen668 20061212改进-适合乐透-
'==========================================================
CpParam.Add "","全1", "{自定走势}{自定义尾}{全1}{除2}{除3}{除4}{除5}{除6}{除7}{除8}{除9}{除10}{奇号}{偶号}{小号}{大号}{小尾}{大尾}{走小尾}{走大尾}"'用户设置参数
CpParam.Add "隔", 0,"{-9}{-8}{-7}{-6}{-5}{-4}{-3}{-2}{-1}{0}{1}{2}{3}{4}{5}{6}{7}{8}{9}"
CpParam.Add "横距",+5'输入 -整数 表示小于，输入正数表示等于，输入+整数 表示大于，输入0显示分区颜色
'Pub_*** = MsgBox (Chr(10)&"是--排序号码"&Chr(10)&Chr(10)&"否--都不排序"&Chr(10)&Chr(10)&"取消--不排序最末号码", 3,"是否排序开奖号码--间隔走势图")
Function Main()
'===============申明或定义变量=============
CpRowCount = CpData.RowCount'+abs(CInt(CpParam.Value("隔")))
CpColCount = CpData.ColCount
CpMinCode = CpData.MinCode
CpMaxCode = CpData.MaxCode
CpCodeCount = CpData.CodeCount '号码数量
a= abs(CInt(CpParam.Value("隔")))
ub_PdDx=left(CpParam.Value("横距") ,1)
ub_HxJj =abs(Cint(CpParam.Value("横距") ))+1



ub_Duan = CpParam.Value("")
'分段
ub_CS=1
ub_Count = CpCodeCount
if CpCodeCount mod 2 =1 then k=1
ub_GWZSCount = 10
ReDim Pub_GWZS(Pub_GWZSCount)
ReDim Pub_GW(Pub_Count)
If Pub_Duan = "奇号" Then
ub_Count =CpCodeCount \2+k
For i = 0 to Pub_Count
ub_GW(i) = i*2
Next
ub_GWZSCount = 5
For i = 0 to 4
ub_GWZS(i) = i*2+1
Next
ElseIf Pub_Duan = "偶号" Then
Pub_Count = CpCodeCount \2
For i = 0 to Pub_Count
Pub_GW(i) = i*2+1
Next
Pub_GWZSCount = 5
For i = 0 to 4
Pub_GWZS(i) = i*2
Next
ElseIf Pub_Duan = "小号" Then
Pub_Count = CpCodeCount \2+k
For i = 0 to Pub_Count
Pub_GW(i) = i
Next
For i = 0 to 9
Pub_GWZS(i) = i
Next
ElseIf Pub_Duan = "大号" Then
Pub_Count = CpCodeCount \2+k
For i = 0 to Pub_Count
Pub_GW(i) = i+Pub_Count-k
Next
For i = 0 to 9
Pub_GWZS(i) = i
Next
ElseIf (Pub_Duan = "小尾") Then
For i = 0 to 4
Pub_GWZS(i) = i
if i=4 then i=9
For bb = i to CpMaxCode-1 step 10
Pub_GW(s) = bb
s=s+1
Next
Next
Pub_Count = s
Pub_GWZSCount = 5
Pub_FQYS=1
WSLB="12340"
ElseIf (Pub_Duan = "走小尾") Then
For i = 0 to 4
Pub_GWZS(i) = i
Next
For bb = 1 to CpMaxCode
if bb mod 10 <5 then
Pub_GW(s) = bb-1
s=s+1
end IF
Next
Pub_Count = s
Pub_GWZSCount = 5
ElseIf (Pub_Duan = "大尾") Then
For i = 0 to 4
Pub_GWZS(i) = i+5
For bb = i+4 to CpMaxCode-1 step 10
Pub_GW(s) = bb
s=s+1
Next
Next
Pub_Count = s
Pub_GWZSCount = 5
Pub_FQYS=1
WSLB="56789"
ElseIf (Pub_Duan = "走大尾") Then
For i = 0 to 4
Pub_GWZS(i) = i+5
Next
For bb = 1 to CpMaxCode
if bb mod 10 >4 then
Pub_GW(s) = bb-1
s=s+1
end if
Next
Pub_Count = s
Pub_GWZSCount = 5
ElseIf (Pub_Duan = "自定走势") Then
ZdyJT=InputBox("输入数字后确定方有效"&Chr(13)&Chr(13)&"友情提示:请紧挨着输入","自定义走势的尾数","0123")
Pub_GWZSCount=Len(ZdyJT)
WSLB=""
For j =1 to Pub_GWZSCount
GS=0
B=Left(ZdyJT,J) mod 10
For I =J+1 to Pub_GWZSCount
BB=Left(ZdyJT,I) mod 10
IF B=BB THEN GS=1 :EXIT FOR
Next
IF GS<>1 THEN WSLB=WSLB&B : w=w+1
Next
Pub_GWZSCount = w
For j =1 to Pub_GWZSCount
Pub_GWZS(j-1)=Left(WSLB,J) mod 10
Next
For hm =CpMinCode to CpMaxCode
aa=hm mod 10
if instr(WSLB,aa)>0 then
Pub_GW(s) =hm-1
s=s+1
end if
Next
Pub_Count = s
ElseIf (Pub_Duan = "自定义尾") Then
ZdyJT=InputBox("输入数字后确定方有效"&Chr(13)&Chr(13)&"友情提示:请紧挨着输入","自定义尾数","0123")
Pub_GWZSCount=Len(ZdyJT)
WSLB=""
For j =1 to Pub_GWZSCount
GS=0
B=Left(ZdyJT,J) mod 10
For I =J+1 to Pub_GWZSCount
BB=Left(ZdyJT,I) mod 10
IF B=BB THEN GS=1 :EXIT FOR
Next
IF GS<>1 THEN WSLB=WSLB&B : w=w+1
Next
Pub_GWZSCount = w
For j =1 to Pub_GWZSCount
ww=Left(WSLB,J) mod 10
Pub_GWZS(j-1)=ww
For hm =CpMinCode to CpMaxCode
if hm mod 10 =ww then
Pub_GW(s) =hm-1
s=s+1
end if
Next
Next
Pub_Count = s
Pub_FQYS=1
Else
'Pub_CS=CInt(Right(Pub_Duan,1))
'要除11 12等大于10的数启用，格式为“011”或“ 11”，前面加一个即可
Pub_CS=Cint(Mid(Pub_Duan,2))
if Pub_CS=0 then Pub_CS=10
For i = 0 to Pub_CS-1
For bb = i to CpMaxCode-1 step Pub_CS
Pub_GW(s) = bb
s=s+1
Next
Next
For i = 0 to 9
Pub_GWZS(i) = i
Next



Pub_Duan=Pub_Duan&"分布"
End If



if CInt(CpParam.Value("隔"))>0 then
PD=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)
if Pub_***=2 then Bhmwh=1ub_***=6
For row = 0 to CpRowCount - 1
For Col=0 to CpColCount-1
Hm(row,Col)=CpData.Code(Row,Col)
Next
If Pub_***=6 then '大小排序号码
For i=0 to CpColCount-2
For j=i+1 to CpColCount-1-Bhmwh
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
For i = 0 to Pub_Count-1
CpAna.AddField Pub_GW(i)+1,2
Next
CpAna.AddField Pub_Duan&"数",5+Pub_CS
if Pub_CS >1 then
For i = 1 to Pub_CS
CpAna.AddField "余"&i mod Pub_CS,3
Next
CpAna.AddField "段数",4
CpAna.AddField "同落0",6
J_L=Pub_CS +2
end if
For i = 1 to CpColCount
CpAna.AddField "基"&i,3
Next
CpAna.AddField "合值",4
For i =1 to CpColCount
CpAna.AddField "基"&i&"尾",3
Next
For i = 0 to Pub_GWZSCount-1
CpAna.AddField Pub_GWZS(i)&"尾个数",4
Next
CpAna.AddField "尾数数",6
CpAna.AddField "新尾",4
CpAna.AddField "旧尾",4



CpAna.RowCount = hanshu
CpAna.CreateTable()

'接下帖

'接上贴
'==============算法主体============================
ReDim WSGS(CpRowCount,12) '
ReDim JianGe(CpMaxCode,CpColCount)'存间隔开奖号
ReDim CFFB(Pub_CS)
ReDim JJGe(CpColCount+1)
row0=0
JJGE(0)=-1



For s=0 to xuanzhe
For row= s+pd to CpRowCount -1 step a+1
hz=0
DS=0
TL0=0
jjgs=0'多少个横间距
For i = 0 to Pub_CS-1
CFFB(I)=0
NEXT
FBZT=""
For i = 0 To CpMaxCode - 1
For col= 0 To CpColCount - 1
JianGe(i,col) = 0
next
JianGe(I,CpColCount) = 0
Next
CpAna.Cell(row0, "期号") = CpData.Seq(row)
CpAna.Color(row0, "期号") = CpColor.IndexOf((s+1) mod 4 )
For col= 0 To CpColCount - 1
code = Hm(row,col)
JianGe(code - 1,col) = code
JianGe(code - 1,CpColCount) = 1
JJGE(col+1)=CpMinCode
Next
'把开奖号填入走势图及基号位置
For code = 0 to Pub_Count-1
i = ub_GW(code)
for col = 0 to CpColCount - 1
If JianGe(i,col)>0 Then
If i < 9 Then
CpAna.Cell(row0, CStr(i) + 1&"") = "0" & i + 1
Else
CpAna.Cell(row0, CStr(i) + 1&"") = i + 1
End If
hz=hz+ JianGe( CStr(i),col)
CpAna.Cell(row0, col+2+Pub_Count+J_L) =JianGe( CStr(i),col)'显示号码
hmws= JianGe( CStr(i),col) mod 10
CpAna.Cell(row0, col+3+Pub_Count+CpColCount+J_L) =hmws '显示尾数
if col=CpColCount-1 then CpAna.Color(row0, CStr(i) + 1&"") =255
gw = (i+1) mod 10
WSGS(row0,gw)=1+WSGS(row0,gw)
FB=JianGe( CStr(i),col) mod Pub_CS
CFFB(FB)=CFFB(FB)+1
jjgs=jjgs+1
JJGE(jjgs)=code
'不要色彩自行删除'走势图有分区时加色彩-开始
ELSEif Pub_HxJj =1 then'走势图有分区时加色彩-开始
if Pub_CS>1 then
if I MOD Pub_CS MOD 2 =1 THEN CpAna.BKCOLOR(row0, I+1&"")=vbwhite
elseIf ub_FQYS=1 Then
ys=Instr(WSLB,((i+1) mod 10)) mod 2
if ys=0 then CpAna.BKCOLOR(row0, I+1&"")=vbwhite
else
ys=((i+1)\10) mod 2
if ys=1 then CpAna.BKCOLOR(row0, I+1&"")=vbwhite
end if'走势图有分区时加色彩--结束
End If
next
Next



JJGE(jjgs+1)= ub_Count
'对符合要求的横距加灰色底
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

'接下帖

'接上贴
'分区分布情况
IF ub_CS>1 THEN
For ii = 1 to Pub_CS
i= ii mod Pub_CS
FBZT=FBZT& CFFB(Ii)&""
CpAna.Cell(row0, "余"&i) =CFFB(I)
if ii mod 2 =0 then CpAna.BKCOLOR(row0, "余"&i)=vbwhite
IF CFFB(I)>0 THEN
DS=DS+1
elseif row0>0 then
if Cint( CpAna.Cell(row0-1,"余"&i) )=0 then TL0=TL0+1
end if
NEXT
CpAna.Cell(row0, "段数") =DS
CpAna.Color(row0, "段数") =255
if row0>0 then
TL0_GS=Pub_CS- Cint( CpAna.Cell(row0-1,"段数") )
CpAna.Cell(row0-1, "同落0") =TL0_GS&":"&TL0
end if
END IF
CpAna.Cell(row0,CpColCount+2+Pub_Count+J_L) = hz
CpAna.Color(row0,CpColCount+2+Pub_Count+J_L) = CpColor.IndexOf(s mod 4)
CpAna.Cell(row0, Pub_Count+1) =FBZT& CFFB(0)&""
CpAna.Color(row0,Pub_Count+1) = CpColor.blue
'尾数个数
For i = 0 to Pub_GWZSCount-1
gw = ub_GWZS(i)
If WSGS(row0,gw) > 0 Then
CpAna.Cell(row0, CStr(gw)&"尾个数") = WSGS(row0,gw)
CpAna.Color(row0, CStr(gw)&"尾个数") = CpColor.IndexOf(WSGS(row0,gw)-1)
WSGS(row0,12)= WSGS(row0,12)+1'尾数数
If row0>0 then
if WSGS(row0-1,gw)=0 then
WSGS(row0,10)= WSGS(row0,10)+1'新
else
WSGS(row0,11)= WSGS(row0,11)+1'旧
end if
End if
End If
Next
CpAna.Cell(row0,"尾数数") = WSGS(row0,12)
CpAna.Cell(row0,"新尾") = WSGS(row0,10)
CpAna.Cell(row0,"旧尾") = WSGS(row0,11)



row0=row0+1
Next
Next
if row0>0 and Pub_CS>1 then
TL0_GS=Pub_CS - Cint( CpAna.Cell(row0-1, "段数") )
CpAna.Cell(row0-1, "同落0") =TL0_GS&":-"
end if
End Function
'-----------说明-----只适合乐透------------
'20050918
'默认间隔0,全部走势；
'
'隔 处选择正数的是表示只显示按照符合间隔及分段的走势图(=单独)
'隔 处选择负数的是表示显示所有期数按照间隔及分段走势图(=完整)
'
'隔1表示从开奖第一期取间隔1的期"1,3,5..."的期数；
'隔-1同间隔1,显示所有开奖期数
'同理间隔3表示从开奖第一期取间隔1的期"1,5,9..."的期数；
'隔-3同隔3,显示所有开奖期数
'
'自己调整分析范围的开始期数会有所不同的走势
'
'分段选择大小号的时候,是按照开奖号码的大小区分,
'
'20060228增加多种尾数图和号码分段走势区别
'要除大于10的，如11请输入111，或者011,即前面多个数字
'
'20061212增加走势图横向间距判断加色
'取代原号码走势横向间距最后一个没判断
' "横距",处 输入-5 表示小于5
' 输入5 表示等于5
' 输入+5 表示大于5
' 输入0显示分区颜