加载中…
个人资料
ysx338372
ysx338372
  • 博客等级:
  • 博客积分:0
  • 博客访问:6,241
  • 关注人气:2
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
相关博文
推荐博文
正文 字体大小:

vb代码(彩票生成器)

(2012-12-15 14:38:03)
标签:

杂谈

■彩票生成器
▲窗体加载
Private Sub Form_Load()
Dim i
For i = 1 To 40
Combo1.AddItem i
Next i
For i = 1 To 7
Combo3.AddItem Choose(i, "双色球", "超级大乐透", "排列三", "排列五", "七星彩", "七乐彩", "福彩3D")
Next i
Combo1.Text = Combo1.List(0):  Combo1_Click: Label1.Caption = ""
Dialog2.Caption = "彩票生成器": Combo3.Text = Combo3.List(0):
End Sub
▲下拉列表框1单击代码
Private Sub Combo1_Click()
Dim i, s, a: a = Val(Combo1.Text): Combo2.Clear
For i = 1 To a
Combo2.AddItem i
Next i
Combo2.Text = Combo2.List(0)
End Sub
▲彩票投注系统①(a选b,有重复号码,有重复记录)
Private Sub OKButton_Click()
Dim a, b, i, j, x, y, s, msg, n
a = Val(Combo1.Text): b = Val(Combo2.Text)
n = Val(InputBox("请输入投入注数", "输入注数")): x = 1: List1.Clear
If Check1.Value = 1 Then Call fileclear(App.Path & "\cp2.txt")
While x <= n
 s = "": DoEvents
 For i = 1 To b
  s = ctxt(" ", s, znum(Int((a - 1) * Rnd + 1), 2))
 Next i
 List1.AddItem IIf(Check2.Value = 1, px(s), s): Call fileadd(App.Path & "\cp2.txt", 0, IIf(Check2.Value = 1, px(s), s)): x = x + 1
Wend
msg = MsgBox(ctxt(vbCrLf, "随机数组合投注列表已经完成", "共生成" & n & "注投注列表"), 0 + 64, "随机数组合投注列表完成")
End Sub
▲彩票投注系统②(a选b,无重复号码,有重复记录)
Private Sub Okbutton2_Click()
Dim i, s, a, b, j, x, y, d: a = Val(Combo1.Text): b = Val(Combo2.Text): Dim m(), n(): ReDim m(1 To b)
d = Val(InputBox("请输入选数", "选数", 1)):
If d = 0 Then Exit Sub
If d <= 0 Then y = MsgBox("选数要大于0", 0 + 16, "选数错误"): List1.Clear: Exit Sub
ReDim n(1 To d): y = 1
While y <= d
 x = 1: s = ""
 While x <= b
  m(x) = Int(Rnd * (a - 1) + 1): j = 0
  For i = 1 To x - 1
   If m(x) = m(i) Then j = j + 1
  Next i
  If j = 0 Then x = x + 1
 Wend
 For i = 1 To b
  s = s & IIf(i = 1, "", " ") & znum(m(i), 2)
 Next i
 j = 0: n(y) = s: y = y + 1
Wend
List1.Clear
For i = 1 To d
List1.AddItem IIf(Check2.Value = 1, px(n(i)), n(i))
Next i
End Sub
▲彩票投注系统③(a选b,无重复号码,无重复记录)
Private Sub OKbutton3_Click()
Dim i, s, a, b, j, x, y, d: a = Val(Combo1.Text): b = Val(Combo2.Text): Dim m(), n(): ReDim m(1 To b)
d = Val(InputBox("请输入选数", "选数", 1)):
If d <= 0 Then y = MsgBox("选数要大于0", 0 + 16, "选数错误"): List1.Clear: Exit Sub
If d > permut(a, b) Then y = MsgBox("所生成的选数大于总数", 0 + 16, "选数错误"): List1.Clear: Exit Sub
ReDim n(1 To d): y = 1
While y <= d
 x = 1: s = ""
 While x <= b
  m(x) = Int(Rnd * (a - 1) + 1): j = 0
  For i = 1 To x - 1
   If m(x) = m(i) Then j = j + 1
  Next i
  If j = 0 Then x = x + 1
 Wend
 For i = 1 To b
  s = s & IIf(i = 1, "", " ") & znum(m(i), 2)
 Next i
 j = 0
 For i = 1 To y - 1
  If s = n(i) Then j = j + 1
 Next i
 If j = 0 Then n(y) = s: y = y + 1
Wend
List1.Clear
For i = 1 To d
List1.AddItem IIf(Check2.Value = 1, px(n(i)), n(i))
Next i
End Sub
▲全国联网彩票投注
Private Sub Cmdsxq_Click()
Dim i, s, a, b, j, x, y, t, s1, s2, msg: Dim m(), n
For i = 0 To Combo3.ListCount - 1
 If Combo3.Text = Combo3.List(i) Then Exit For
Next i
i = i + 1
If i = 1 Then '双色球
 b = InputBox("请输入注数", "双色球"): y = 1: List1.Clear: ReDim m(1 To 6)
 If Check1.Value = 1 Then Call fileclear(App.Path & "\cps.txt")
 While y <= Val(b)
  x = 1: DoEvents
  While x <= 6
   m(x) = Int(Rnd * (34 - 1) + 1): j = 0
   For i = 1 To x - 1
    If m(x) = m(i) Then j = j + 1
   Next i
   If j = 0 And m(x) <> 0 Then x = x + 1
  Wend
  s = ""
  For i = 1 To 6
   s = ctxt(" ", s, znum(m(i), 2))
  Next i
  a = Int(Rnd * (17 - 1) + 1): s = ctxt("-", px(s), znum(a, 2))
  List1.AddItem s: Call fileadd(App.Path & "\cps.txt", 0, s): Label1.Caption = y & "/" & b: y = y + 1
 Wend
 msg = MsgBox(ctxt(vbCrLf, "双色球投注列表已经完成", "共生成" & b & "注投注列表"), 0 + 64, "双色球投注列表完成")
ElseIf i = 2 Then '超级大乐透
 b = InputBox("请输入注数", "超级大乐透"): y = 1: List1.Clear: ReDim m(1 To 5)
 If Check1.Value = 1 Then Call fileclear(App.Path & "\cpc.txt")
 While y <= Val(b)
  x = 1: DoEvents
  While x <= 5
   m(x) = Int(Rnd * (36 - 1) + 1): j = 0
   For i = 1 To x - 1
    If m(x) = m(i) Then j = j + 1
   Next i
   If j = 0 And m(x) <> 0 Then x = x + 1
  Wend
  s = ""
  For i = 1 To 5
   s = ctxt(" ", s, znum(m(i), 2))
  Next i
  s1 = s: s = "": x = 1:
  While x <= 2
   m(x) = Int(Rnd * (13 - 1) + 1): j = 0
   For i = 1 To x - 1
    If m(x) = m(i) Then j = j + 1
   Next i
   If j = 0 And m(x) <> 0 Then x = x + 1
  Wend
  For i = 1 To 2
   s = ctxt(" ", s, znum(m(i), 2))
  Next i
  s2 = s: s = ctxt("-", px(s1), px(s2)): List1.AddItem s: Call fileadd(App.Path & "\cpc.txt", 0, s): Label1.Caption = y & "/" & b: y = y + 1
 Wend
 msg = MsgBox(ctxt(vbCrLf, "超级大乐透投注列表已经完成", "共生成" & b & "注投注列表"), 0 + 64, "超级大乐透投注列表完成")
ElseIf i = 3 Then '排列三
 b = InputBox("请输入注数", "排列三"): y = 1: List1.Clear
 While y <= Val(b)
  s = ""
  For i = 1 To 3
   a = Int((10 - 0) * Rnd): s = ctxt(" ", s, a)
  Next i
  List1.AddItem s: y = y + 1
 Wend
 msg = MsgBox(ctxt(vbCrLf, "排列三投注列表已经完成", "共生成" & Val(b) & "注投注列表"), 0 + 64, "排列三投注列表完成")
ElseIf i = 4 Then '排列五
 b = InputBox("请输入注数", "排列五"): y = 1: List1.Clear
 While y <= Val(b)
  s = ""
  For i = 1 To 5
   a = Int((10 - 0) * Rnd): s = ctxt(" ", s, a)
  Next i
  List1.AddItem s: y = y + 1
 Wend
 msg = MsgBox(ctxt(vbCrLf, "排列五投注列表已经完成", "共生成" & Val(b) & "注投注列表"), 0 + 64, "排列五投注列表完成")
ElseIf i = 5 Then '七星彩
 n = InputBox("请输入注数", "七星彩"): y = 1: List1.Clear
 While y <= Val(n)
  s = "": DoEvents
  For i = 1 To 7
   a = Int((10 - 0) * Rnd): s = ctxt(" ", s, a)
  Next i
  List1.AddItem s: y = y + 1
 Wend
 msg = MsgBox(ctxt(vbCrLf, "七星彩投注列表已经完成", "共生成" & Val(n) & "注投注列表"), 0 + 64, "七星彩投注列表完成")
ElseIf i = 6 Then '七乐彩
 b = InputBox("请输入注数", "七乐彩"): y = 1: List1.Clear: ReDim m(1 To 7)
 While y <= Val(b)
  x = 1: DoEvents
  While x <= 7
   m(x) = Int(Rnd * (31 - 1) + 1): j = 0
   For i = 1 To x - 1
    If m(x) = m(i) Then j = j + 1
   Next i
   If j = 0 And m(x) <> 0 Then x = x + 1
  Wend
  s = ""
  For i = 1 To 7
   s = ctxt(" ", s, znum(m(i), 2))
  Next i
  List1.AddItem px(s): y = y + 1
 Wend
 msg = MsgBox(ctxt(vbCrLf, "七乐彩投注列表已经完成", "共生成" & b & "注投注列表"), 0 + 64, "七乐彩投注列表完成")
ElseIf i = 7 Then '福彩3D
 b = InputBox("请输入注数", "福彩3D"): y = 1: List1.Clear
 While y <= Val(b)
  s = ""
  For i = 1 To 3
   a = Int((10 - 0) * Rnd): s = ctxt(" ", s, a)
  Next i
  List1.AddItem s: y = y + 1
 Wend
 msg = MsgBox(ctxt(vbCrLf, "福彩3D投注列表已经完成", "共生成" & Val(b) & "注投注列表"), 0 + 64, "福彩3D投注列表完成")
Else
End If
End Sub
▲将生成的彩票号码保存到文件中
Private Sub Cmdwritte_Click()
Dim i, z, s, msg: z = ""
If List1.ListCount = 0 Then Exit Sub
Cd.FileName = "": Cd.Filter = "文本文件(*.txt)|*.txt": Cd.ShowSave: z = Cd.FileName
If z = "" Then Exit Sub
If Check1.Value = 0 Then Call Module1.fileclear(z)
For i = 0 To List1.ListCount - 1
 DoEvents: Call fileadd(z, 0, List1.List(i))
 Label1.Caption = CStr(i + 1) & "/" & List1.ListCount
Next i
msg = MsgBox("保存记录已经完成!", 0 + 64, "保存记录")
End Sub
▲将生成的号码排序
Public Function px(s)
Dim i, c, a, r, m(), j: c = dec(s, " ") + 1: ReDim m(1 To c)
For i = 1 To c
m(i) = Val(dtxt(s, " ", i))
Next i
For i = c To 2 Step -1
 For j = 1 To i - 1
  If m(j) > m(j + 1) Then
   a = m(j + 1): m(j + 1) = m(j): m(j) = a
  End If
 Next j
Next i
r = ""
For i = 1 To c
 r = ctxt(" ", r, znum(m(i), 2))
Next i
px = r
End Function
▲求排列数的代码
Public Function permut(n, r)
Dim a, i: a = 1
For i = n To n - r + 1 Step -1
a = a * i
Next i
permut = a
End Function

0

阅读 评论 收藏 转载 喜欢 打印举报/Report
  • 评论加载中,请稍候...
发评论

    发评论

    以上网友发言只代表其个人观点,不代表新浪网的观点或立场。

      

    新浪BLOG意见反馈留言板 电话:4000520066 提示音后按1键(按当地市话标准计费) 欢迎批评指正

    新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 会员注册 | 产品答疑

    新浪公司 版权所有