vb 编写一个抽奖程序 用vb编一个抽奖程序

vb\u7f16\u5199\u4e00\u4e2a\u6a21\u62df\u62bd\u5956\u7684\u7a0b\u5e8f(\u6025~~~\u8c22\u8c22)

'\u9700\u8981\u4e00\u4e2alabel \u4e24\u4e2acommand \u4e00\u4e2atime\u63a7\u4ef6

Private Sub Command1_Click()
Timer1.Enabled = True
Command2.Enabled = True
Command1.Enabled = False
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
Command1.Enabled = True
Command2.Enabled = False
End Sub

Private Sub Form_Load()
Command1.Caption = "Open"
Command2.Caption = "End"
Command2.Enabled = False
Label1.Caption = "1"
Label1.Alignment = 2
Timer1.Interval = 100
Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
Label1.Caption = CInt(Rnd * 99 + 100)
End Sub

Private Sub Command1_Click()
Dim WinNum$, RndNum$, i&, j&
Randomize
WinNum = "6720819"
For i = 1 To 7
RndNum = RndNum & Int(Rnd * 10)
Next

Print "\u4e2d\u5956\u53f7:"; WinNum, "\u968f\u673a\u6570:"; RndNum, WinLevel(WinNum, RndNum)


End Sub

Function WinLevel$(WinNum$, RndNum$)
Dim a$(), i&, j&, k&
For i = 7 To 3 Step -1
For j = 0 To 7 - i
ReDim Preserve a(k)
a(k) = Mid(RndNum, j + 1, i)
k = k + 1
Next
Next
For i = 0 To k - 1
If InStr(WinNum, a(i)) > 0 Then
WinLevel = Mid("\u4e00\u4e8c\u4e09\u56db\u4e94", 8 - Len(a(i)), 1) & "\u7b49\u5956"
Exit Function
End If
Next
WinLevel = "\u6ca1\u83b7\u5956"
End Function

command1用来随机抽取，text2显示
text1用来自己输入
command2用来判断
基本思想：假设连续有a位相同，经过验证如果为真则得出结果，如果为假，则假设a=a-1位相同……直到a=0
也可以自己输入text2数据来检验程序
这段程序不局限于7位数

Private Sub Command2_Click()
Dim a$, b$, i%, j%, k%
a = CStr(Text1)
b = CStr(Text2)
For i = Len(a) To 1 Step -1
For j = 1 To Len(a) - i + 1
If Mid(a, j, i) = Mid(b, j, i) Then
k = i
Exit For
End If
Next
If k <> 0 Then Exit For
Next
Print k, Mid(a, j, i)'输出相同位数和相同数字
If len(a)+1-k>5 Then
MsgBox "对不起，无奖项"
Else
MsgBox Len(a) + 1 - k & "等奖"'判断奖项
End If
End Sub

Private Sub Command1_Click()
a = CStr(Text1)
Text2 = 10 ^ (Len(a) - 1) + Int(Rnd * 0.9 * 10 ^ Len(a))
End Sub

1234567
0012555

这是几等奖？ 重复数字如何处理？

# 下面这段符合要求不：

Private Sub Command1_Click()
Dim awdStr$, rndStr$, JX$, i%, k%
Do While Len(awdStr) <> 7 Or Not IsNumeric(awdStr)
awdStr = InputBox("请输入中奖密码")
Loop
Randomize
rndStr = Format(Int(Rnd * 100000 + 1), "0000000")
For i = 1 To 7
If InStr(rndStr, Mid(awdStr, i, 1)) > 0 Then k = k + 1
Next i
If k > 2 Then JX = Mid("五四三二一", k - 2, 1) & "等奖" Else JX = "未中奖"
Print "中奖号码: "; awdStr
Print "随机号码: "; rndStr
Print "所中奖项: "; k & "位相同， " & JX
End Sub

Private Sub Command1_Click()
Dim WinNum$, RndNum$, i&, j&
Randomize
WinNum = "4720859"
For i = 1 To 7
RndNum = RndNum & Int(Rnd * 10)
Next

Print "中奖号:"; WinNum, "随机数:"; RndNum, WinLevel(WinNum, RndNum)

End Sub

Function WinLevel$(WinNum$, RndNum$)
Dim a$(), i&, j&, k&
For i = 7 To 3 Step -1
For j = 0 To 7 - i
ReDim Preserve a(k)
a(k) = Mid(RndNum, j + 1, i)
k = k + 1
Next
Next
For i = 0 To k - 1
If InStr(WinNum, a(i)) > 0 Then
WinLevel = Mid("一二三四五", 8 - Len(a(i)), 1) & "等奖"
Exit Function
End If
Next
WinLevel = "没获奖"
End Function