📄 frm_main6.frm
字号:
Left = 3960
Top = 6600
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame1
Caption = "随机号码"
Height = 855
Left = 0
TabIndex = 14
Top = 480
Width = 7935
End
Begin VB.Label Label4
Caption = "Label2"
Height = 255
Left = 2040
TabIndex = 17
Top = 6000
Width = 855
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "目前四等奖为个数为："
Height = 180
Left = 120
TabIndex = 16
Top = 6000
Width = 1800
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "末等奖抽奖系统"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 2640
TabIndex = 15
Top = 0
Width = 2205
End
End
Attribute VB_Name = "frm_Main6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim flag As Boolean
Private Sub cmdBegin_Click()
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
'If strFilePath = "" Then
' MsgBox "请先选择一个数据库文件！ ", vbInformation + vbOKOnly, "提示信息"
' Exit Sub
'End If
If IntTotalPersonCount < 1 Then
MsgBox "目前注册用户为零不能进行抽奖！ ", vbInformation + vbOKOnly, "提示信息"
Exit Sub
End If
If cmdBegin.Caption = "开始" Then
Timer1.Enabled = True
cmdBegin.Caption = "停止"
cmdBegin.SetFocus
Else
Dim j As Integer
Dim RstSQL As New ADODB.Recordset
Dim RndNumber As Integer
For j = 1 To 20
flag = False
Randomize
RndNumber = Int(IntTotalPersonCount * Rnd + 1)
Rs.Open "select count(*) as ll from temp3 WHERE Person_ID=" & RndNumber, CnnDSN, 1, 3
If Rs.Fields("ll") = 0 Then
'如果没有，则将抽取的人员插入到temp1表中
CnnDSN.Execute ("insert into temp3(Person_ID,Invoice_ID,Person_Name,Person_Tel) SELECT Person_ID,Invoice_ID,Person_Name,Person_Tel from Lottery_Table WHERE Person_ID=" & RndNumber)
Else
'保证每次必须抽取一个人
Do While flag = False
Randomize
RndNumber = Int(IntTotalPersonCount * Rnd + 1)
Rs.Close
Rs.Open "select count(*) as ll from temp3 WHERE Person_ID=" & RndNumber, CnnDSN, 1, 3
If Rs.Fields("ll") = 0 Then
'如果没有，则将抽取的人员插入到temp1表中
CnnDSN.Execute ("insert into temp3(Person_ID,Invoice_ID,Person_Name,Person_Tel) SELECT Person_ID,Invoice_ID,Person_Name,Person_Tel from Lottery_Table WHERE Person_ID=" & RndNumber)
flag = True
End If
Loop
End If
Rs.Close
Next
cmdBegin.Caption = "开始"
Timer1.Enabled = False
Unload Me
frm_Main6.Show
Adodc1.CommandType = adCmdText
Adodc1.ConnectionString = CnnDSN
Adodc1.RecordSource = "SELECT Person_ID as 人员编号,Invoice_ID AS 身份证号,Person_Name as 姓名,Person_Tel as 电话 FROM temp3"
Set DataGrid1.DataSource = Adodc1
Adodc1.Refresh
End If
End Sub
Private Sub cmdCancel_Click()
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
End Sub
Private Sub Form_Load()
flag = False
Dim RstSQL As New ADODB.Recordset
With RstSQL
.ActiveConnection = CnnDSN
.Source = "SELECT * FROM Lottery_Table"
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open
End With
IntTotalPersonCount = RstSQL.RecordCount
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2 - 500
Me.Caption = "《钢都周报》--抽奖程序[目前共有" & Str(IntTotalPersonCount) & " 位注册用户]"
Dim RstSQL1 As New ADODB.Recordset
With RstSQL1
.ActiveConnection = CnnDSN
.Source = "SELECT * FROM temp3"
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open
End With
yicount = RstSQL1.RecordCount
Label4.Caption = yicount
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuName_Click()
frm_About.Show 1
End Sub
Private Sub mnuOpen_Click()
Dim RstSQL As New ADODB.Recordset
'设置“CancelError”为 True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
'设置标志
CommonDialog1.Flags = cdlOFNHideReadOnly
'设置过滤器
CommonDialog1.Filter = "All Files (*.*)|*.*|Access (*.mdb)|*.mdb"
'指定缺省的过滤器
CommonDialog1.FilterIndex = 2
'显示“打开”对话框
CommonDialog1.ShowOpen
'
strFilePath = CommonDialog1.FileName
CnnDSN.Provider = "Microsoft.Jet.OLEDB.4.0"
CnnDSN.ConnectionString = "Lottery_Table.mdb"
CnnDSN.Open
With RstSQL
.ActiveConnection = CnnDSN
.Source = "SELECT * FROM Lottery_Table"
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open
End With
IntTotalPersonCount = RstSQL.RecordCount
frm_Main.Caption = "英语沙龙--抽奖程序[目前共有" & Str(IntTotalPersonCount) & " 位注册用户]"
RstSQL.Close
Exit Sub
'
ErrHandler:
'用户按了“取消”按钮
Exit Sub
End Sub
Private Sub mnuSelect_Click()
frm_Select.Show 1
End Sub
Private Sub Label3_Click()
End Sub
Private Sub open_Click()
Dim RstSQL As New ADODB.Recordset
'设置“CancelError”为 True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
'设置标志
CommonDialog1.Flags = cdlOFNHideReadOnly
'设置过滤器
CommonDialog1.Filter = "All Files (*.*)|*.*|Access (*.mdb)|*.mdb"
'指定缺省的过滤器
CommonDialog1.FilterIndex = 2
'显示“打开”对话框
CommonDialog1.ShowOpen
'
strFilePath = CommonDialog1.FileName
CnnDSN.Provider = "Microsoft.Jet.OLEDB.4.0"
CnnDSN.ConnectionString = strFilePath
CnnDSN.Open
With RstSQL
.ActiveConnection = CnnDSN
.Source = "SELECT * FROM Lottery_Table"
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open
End With
IntTotalPersonCount = RstSQL.RecordCount
frm_Main.Caption = "英语沙龙--抽奖程序[目前共有" & Str(IntTotalPersonCount) & " 位注册用户]"
RstSQL.Close
Exit Sub
'
ErrHandler:
'用户按了“取消”按钮
Exit Sub
End Sub
Private Sub Timer1_Timer()
Text1.Text = CStr(Int(10 * Rnd))
Text2.Text = CStr(Int(10 * Rnd))
Text3.Text = CStr(Int(10 * Rnd))
Text4.Text = CStr(Int(10 * Rnd))
Text5.Text = CStr(Int(10 * Rnd))
Text6.Text = CStr(Int(10 * Rnd))
Text7.Text = CStr(Int(10 * Rnd))
Text8.Text = CStr(Int(10 * Rnd))
Text9.Text = CStr(Int(10 * Rnd))
End Sub
Sub ChangeString(RndNumber As Integer)
Select Case Len(Trim(Str(RndNumber)))
Case 1
Text1.Text = "0"
Text2.Text = "0"
Text3.Text = "0"
Text4.Text = "0"
Text5.Text = "0"
Text6.Text = "0"
Text7.Text = "0"
Text8.Text = "0"
Text9.Text = Mid(Trim(Str(RndNumber)), 1, 1)
Case 2
Text1.Text = "0"
Text2.Text = "0"
Text3.Text = "0"
Text4.Text = "0"
Text5.Text = "0"
Text6.Text = "0"
Text7.Text = "0"
Text8.Text = Mid(Trim(Str(RndNumber)), 1, 1)
Text9.Text = Mid(Trim(Str(RndNumber)), 2, 1)
Case 3
Text1.Text = "0"
Text2.Text = "0"
Text3.Text = "0"
Text4.Text = "0"
Text5.Text = "0"
Text6.Text = "0"
Text7.Text = Mid(Trim(Str(RndNumber)), 1, 1)
Text8.Text = Mid(Trim(Str(RndNumber)), 2, 1)
Text9.Text = Mid(Trim(Str(RndNumber)), 3, 1)
Case 4
Text1.Text = "0"
Text2.Text = "0"
Text3.Text = "0"
Text4.Text = "0"
Text5.Text = "0"
Text6.Text = Mid(Trim(Str(RndNumber)), 1, 1)
Text7.Text = Mid(Trim(Str(RndNumber)), 2, 1)
Text8.Text = Mid(Trim(Str(RndNumber)), 3, 1)
Text9.Text = Mid(Trim(Str(RndNumber)), 4, 1)
Case 5
Text1.Text = "0"
Text2.Text = "0"
Text3.Text = "0"
Text4.Text = "0"
Text5.Text = Mid(Trim(Str(RndNumber)), 1, 1)
Text6.Text = Mid(Trim(Str(RndNumber)), 2, 1)
Text7.Text = Mid(Trim(Str(RndNumber)), 3, 1)
Text8.Text = Mid(Trim(Str(RndNumber)), 4, 1)
Text9.Text = Mid(Trim(Str(RndNumber)), 5, 1)
Case 6
Text1.Text = "0"
Text2.Text = "0"
Text3.Text = "0"
Text4.Text = Mid(Trim(Str(RndNumber)), 1, 1)
Text5.Text = Mid(Trim(Str(RndNumber)), 2, 1)
Text6.Text = Mid(Trim(Str(RndNumber)), 3, 1)
Text7.Text = Mid(Trim(Str(RndNumber)), 4, 1)
Text8.Text = Mid(Trim(Str(RndNumber)), 5, 1)
Text9.Text = Mid(Trim(Str(RndNumber)), 6, 1)
Case 7
Text1.Text = "0"
Text2.Text = "0"
Text3.Text = Mid(Trim(Str(RndNumber)), 1, 1)
Text4.Text = Mid(Trim(Str(RndNumber)), 2, 1)
Text5.Text = Mid(Trim(Str(RndNumber)), 3, 1)
Text6.Text = Mid(Trim(Str(RndNumber)), 4, 1)
Text7.Text = Mid(Trim(Str(RndNumber)), 5, 1)
Text8.Text = Mid(Trim(Str(RndNumber)), 6, 1)
Text9.Text = Mid(Trim(Str(RndNumber)), 7, 1)
Case 8
Text1.Text = "0"
Text2.Text = Mid(Trim(Str(RndNumber)), 1, 1)
Text3.Text = Mid(Trim(Str(RndNumber)), 2, 1)
Text4.Text = Mid(Trim(Str(RndNumber)), 3, 1)
Text5.Text = Mid(Trim(Str(RndNumber)), 4, 1)
Text6.Text = Mid(Trim(Str(RndNumber)), 5, 1)
Text7.Text = Mid(Trim(Str(RndNumber)), 6, 1)
Text8.Text = Mid(Trim(Str(RndNumber)), 7, 1)
Text9.Text = Mid(Trim(Str(RndNumber)), 8, 1)
Case 9
Text1.Text = Mid(Trim(Str(RndNumber)), 1, 1)
Text2.Text = Mid(Trim(Str(RndNumber)), 2, 1)
Text3.Text = Mid(Trim(Str(RndNumber)), 3, 1)
Text4.Text = Mid(Trim(Str(RndNumber)), 4, 1)
Text5.Text = Mid(Trim(Str(RndNumber)), 5, 1)
Text6.Text = Mid(Trim(Str(RndNumber)), 6, 1)
Text7.Text = Mid(Trim(Str(RndNumber)), 7, 1)
Text8.Text = Mid(Trim(Str(RndNumber)), 8, 1)
Text9.Text = Mid(Trim(Str(RndNumber)), 9, 1)
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -