抽 奖

时间:2018-07-06 12:38:16
【文件属性】:

文件名称:抽 奖

文件大小:2KB

文件格式:RAR

更新时间:2018-07-06 12:38:16

抽奖

就是好抽奖vbrivate Sub Command1_Click() On Error GoTo md Dim code, tmp, tmp2, tmp3 As String filename = App.Path & "\data.txt" code = Text1.Text tmp = Left(code, 2) tmp = tmp + "0000" tmp2 = "" Open filename For Input As #1 While Not (EOF(1)) Line Input #1, tmp3 If Left(tmp3, 6) = tmp Then tmp2 = tmp2 + Trim(Mid(tmp3, 7, Len(tmp3) - 6)) Wend tmp2 = tmp2 + " " Close #1 tmp = Left(code, 4) tmp = tmp + "00" Open filename For Input As #1 While Not (EOF(1)) Line Input #1, tmp3 If Left(tmp3, 6) = tmp Then tmp2 = tmp2 + Trim(Mid(tmp3, 7, Len(tmp3) - 6)) Wend tmp2 = tmp2 + " " Close #1 tmp = Left(code, 6) Open filename For Input As #1 While Not (EOF(1)) Line Input #1, tmp3 If Left(tmp3, 6) = tmp Then tmp2 = tmp2 + Trim(Mid(tmp3, 7, Len(tmp3) - 6)) Wend Close #1 Text2.Text = tmp2 Text3.Text = Mid(code, 7, 4) + "年" + Mid(code, 11, 2) + "月" + Mid(code, 13, 2) + "日" tmp = Mid(code, 17, 1) a = Val(tmp) If a Mod 2 = 1 Then Text4.Text = "男" Else Text4.Text = "女" Text6.Text = Mid(code, 15, 3) 'JIAOYAN Dim co(1 To 17) As String For a = 1 To 17 co(a) = Mid(code, a, 1) Next co(1) = co(1) * 7 co(2) = co(2) * 9 co(3) = co(3) * 10 co(4) = co(4) * 5 co(5) = co(5) * 8 co(6) = co(6) * 4 co(7) = co(7) * 2 co(8) = co(8) * 1 co(9) = co(9) * 6 co(10) = co(10) * 3 co(11) = co(11) * 7 co(12) = co(12) * 9 co(13) = co(13) * 10 co(14) = co(14) * 5 co(15) = co(15) * 8 co(16) = co(16) * 4 co(17) = co(17) * 2 Sum = 0 For a = 1 To 17 Sum = Sum + co(a) Next y = Sum Mod 11 www = Right(code, 1) Select Case y Case Is = "0" If www = "1" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "1" If www = "0" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "2" If www = "X" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "3" If www = "9" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "4" If www = "8" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "5" If www = "7" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "6" If www = "6" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "7" If www = "5" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "8" If www = "4" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "9" If www = "3" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Is = "10" If www = "2" Then Text5.Text = "成功" Else Text5.Text = "失败" Case Else Text5.Text = "失败" End Select ok: Exit Sub md: MsgBox "出错!请检查输入是否正确或程序是否完整!请重新启动本程序!": tmp = "": tmp2 = "": tmp3 = "": code = "": www = "": a = 0: Resume ok End Sub Private Sub Command2_Click() Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Text5.Text = "" Text6.Text = "" End Sub Private Sub Command3_Click() MsgBox "Koc 2010" + Chr(13) + "数据来源于国家统计局" + Chr(13) + "说明:(*)表示2008年根据国标修改的县及县以上行政区划代码和名称。" + Chr(13) + "结果仅供参考" End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Command1_Click End Sub


【文件预览】:
627
----Form1.frm(8KB)
----工程1.vbp(592B)
----MSSCCPRJ.SCC(190B)
----工程1.vbw(49B)

网友评论