[分享]博 奥 观 台 VB

[分享]博 奥 观 台 VB
'==========================================================
' 博 奥 观 台---横型
' by-chinamen668 20061208
''为防止列过多导致VB出错.当列达到200多的时候,前期直接取1
'==========================================================
CpParam.Add "前",5,"{1}{2}{3}{4}{5}{6}{7}{8}{9}{10}{11}{12}"
CpParam.Add "选","除数","{除数}{码行}"
CpParam.Add "",5,"{1}{2}{3}{4}{5}{6}{7}{8}{9}{10}{11}{12}"
Function Main
'===============申明或定义变量=============
CpRowCount = CpData.RowCount '开奖期数
CpColCount = CpData.ColCount '开奖号码个数
CpMaxCode = CpData.MaxCode '最大号码
CpMinCode = CpData.MinCode '最小号码
CpCodeCount = CpData.CodeCount '号码数量
ub_Q =Cint( CpParam.Value("前"))
ub_X = CpParam.Value("选")
ub_S =Cint(CpParam.Value(""))
if ub_X ="除数" then
ub_CS = ub_S
ls=CpMaxCode\Pub_CS+2
Hangshu=Pub_S +2
else
ub_GS = ub_S
Hangshu=CpMaxCode\Pub_S+3
ls=Pub_GS +1
end if
if Pub_Q*ls>250 then Pub_Q=1'为防止列过多导致VB出错.
'=================建表=================
For i = 0 to Pub_Q*ls
CpAna.AddField i,2
Next
CpAna.RowCount = hangshu
CpAna.CreateTable()
'==============算法主体=================
For QS =0 to Pub_Q-1
For row =CpMinCode to Pub_CS-(1-CpMinCode)
if Pub_CS=0 then exit for
row0=0
For L = row to CpMaxCode step Pub_CS
tl=""
if L<10 and CpMaxCode>9 then tl=0
CpAna.Cell(row,row0+1+QS*ls) =tl&L
if Instr(CpData.CodeStr(CpRowCount-1-QS),tl&L) then
CpAna.Color(row,row0+1+QS*ls) =255
end if
if CpData.Code(CpRowCount-1-QS,CpColCount-1)=l then
'最末基号加底色
CpAna.BKColor(row,row0+1+QS*ls) =CpColor.Blue
end if
row0=row0+1
Next
Next
code=CpMinCode
For row =CpMinCode to CpMaxCode
for h=1 to Pub_GS
if code>CpMaxCode then exit for
tl=""
if code<10 and CpMaxCode>9 then tl=0
CpAna.Cell(row,h+QS*ls) =tl&code
if Instr(CpData.CodeStr(CpRowCount-1-QS),tl&code) then
CpAna.Color(row,h+QS*ls) =255
end if
if CpData.Code(CpRowCount-1-QS,CpColCount-1)=code then
'最末基号加底色
CpAna.BKColor(row,h+QS*ls) =CpColor.Blue
end if
code=code+1
next
Next
CpAna.Cell(hangshu-1,QS*ls) =qs+1
Next
End Function





[本帖已被作者于2010年2月18日19时21分2秒编辑过]