📄 prizefrm.frm
字号:
VERSION 5.00
Begin VB.Form PrizeFrm
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Caption = "2006年互软年会抽奖区"
ClientHeight = 8895
ClientLeft = 0
ClientTop = 0
ClientWidth = 13215
Icon = "PrizeFrm.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8895
ScaleWidth = 13215
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
WindowState = 2 'Maximized
Begin VB.Timer Timer4
Left = 6000
Top = 6000
End
Begin VB.Timer Timer1
Interval = 500
Left = 4080
Top = 4680
End
Begin VB.PictureBox picPane
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 12960
Left = -2160
ScaleHeight = 864
ScaleMode = 3 'Pixel
ScaleWidth = 1152
TabIndex = 3
Top = -1200
Width = 17280
Begin VB.CommandButton CmdStart
Caption = "开始抽奖"
BeginProperty Font
Name = "隶书"
Size = 39.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 6720
TabIndex = 5
Top = 6120
Width = 4455
End
Begin VB.Label txtName
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
BeginProperty Font
Name = "MS Sans Serif"
Size = 41.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 855
Left = 4200
TabIndex = 6
Top = 2520
Width = 9375
End
Begin VB.Label lbStatus
Alignment = 2 'Center
BackStyle = 0 'Transparent
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1455
Left = 7080
TabIndex = 4
Top = 8040
Width = 3735
WordWrap = -1 'True
End
Begin VB.Image Image3
Height = 1155
Left = 9840
Picture = "PrizeFrm.frx":72FA
Top = 4320
Width = 960
End
Begin VB.Image Image2
Height = 1155
Left = 8400
Picture = "PrizeFrm.frx":AB8E
Top = 4320
Width = 960
End
Begin VB.Image Image1
Height = 1155
Left = 6960
Picture = "PrizeFrm.frx":E422
Top = 4320
Width = 960
End
End
Begin VB.Label txtNum2
Alignment = 2 'Center
BackColor = &H80000009&
BorderStyle = 1 'Fixed Single
Caption = "0"
BeginProperty Font
Name = "MS Sans Serif"
Size = 72
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1815
Left = 5640
TabIndex = 2
Top = 2160
Width = 1815
End
Begin VB.Label txtNum3
Alignment = 2 'Center
BackColor = &H80000009&
BorderStyle = 1 'Fixed Single
Caption = "0"
BeginProperty Font
Name = "MS Sans Serif"
Size = 72
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1815
Left = 7920
TabIndex = 1
Top = 2160
Width = 1815
End
Begin VB.Label txtNum1
Alignment = 2 'Center
BackColor = &H80000009&
BorderStyle = 1 'Fixed Single
Caption = "0"
BeginProperty Font
Name = "MS Sans Serif"
Size = 72
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1815
Left = 3360
TabIndex = 0
Top = 2160
Width = 1815
End
End
Attribute VB_Name = "PrizeFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim curIndex As Integer
Dim curClickNum As Integer
Private Sub CmdStart_Click()
Dim curNum As String
Dim curTime As Date
Dim prizeName As String
curClickNum = curClickNum + 1
If curClickNum Mod 2 = 0 Then
CmdStart.Caption = "开始抽奖"
Timer1.Enabled = True
CmdStart.Enabled = True
Exit Sub
Else
CmdStart.Caption = "继续抽奖"
Timer1.Enabled = False
End If
curTime = Now
'CmdStart.Enabled = False
Timer4.Enabled = False
curNum = txtNum1.Caption & txtNum2.Caption & txtNum3.Caption
curIndex = curIndex + 1
' Do While True
' If DateDiff("s", curTime, Now) > 2 Then Exit Do
' DoEvents
' Loop
Timer4.Enabled = True
Select Case prizeType
Case 1
prizeFirstNum(curIndex) = curNum
prizeName = "一等奖"
lbStatus.Caption = prizeName & "幸运者产生，号码是：" & curNum
If curIndex >= firstCount Then
Timer1.Enabled = False
Timer4.Enabled = False
CmdStart.Enabled = False
'MsgBox "投票结束，让我们期待结果.."
Unload Me
ResultFrm.Show 1
End If
Case 2
prizeSecondNum(curIndex) = curNum
prizeName = "二等奖"
lbStatus.Caption = prizeName & "幸运者产生，号码是：" & curNum
If curIndex >= secondCount Then
Timer1.Enabled = False
Timer4.Enabled = False
CmdStart.Enabled = False
'MsgBox "投票结束，让我们期待结果.."
Unload Me
ResultFrm.Show 1
End If
Case 3
prizeThirdNum(curIndex) = curNum
prizeName = "三等奖"
lbStatus.Caption = prizeName & "幸运者产生，号码是：" & curNum
If curIndex >= thirdCount Then
Timer1.Enabled = False
Timer4.Enabled = False
CmdStart.Enabled = False
'MsgBox "投票结束，让我们期待结果.."
Unload Me
ResultFrm.Show 1
End If
Case 4
prizeSpecialNum(curIndex) = curNum
prizeName = "特等奖"
lbStatus.Caption = prizeName & "幸运者产生，号码是：" & curNum
If curIndex >= specialCount Then
Timer1.Enabled = False
Timer4.Enabled = False
CmdStart.Enabled = False
'MsgBox "投票结束，让我们期待结果.."
Unload Me
ResultFrm.Show 1
End If
End Select
End Sub
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Load()
Dim rollSpeed As Integer
rollSpeed = 50
Dim A As Integer, path As String, APPPATH As String
'获得当前路径8.3格式的短路径名
If Right(App.path, 1) = "\" Then path = App.path Else path = App.path & "\"
APPPATH = String$(165, 0)
A = GetShortPathName(path, APPPATH, 164)
APPPATH = Left(APPPATH, InStr(APPPATH, Chr(0)) - 1)
Res = mciSendString("play " & APPPATH & "images\music.mid from 3000 to 8000", Ret, 1024, 0)
Me.BackColor = RGB(203, 1, 1)
picPane.Picture = LoadPicture(App.path & "/images/prize.jpg")
picPane.Left = (Screen.Width - picPane.Width) / 2
picPane.Top = (Screen.Height - picPane.Height) / 2
txtName.Caption = actionName
Timer1.Interval = rollSpeed
Timer4.Interval = 2000 '抽奖时间间隔
Timer1.Enabled = True
Timer4.Enabled = False
curIndex = 0
' Select Case prizeType
' Case 1
' curIndex = 9
' Case 2
' curIndex = 6
' Case 3
' curIndex = 0
' Case 4
' curIndex = 0
' End Select
curClickNum = 0
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Res = mciSendString("close all", Ret, 1024, 0)
End Sub
Private Sub Timer1_Timer()
CmdStart.SetFocus
Dim txtNum As String
Dim prizeName As String
Dim upNum As Integer
Dim allNum As Integer
txtNum = "" & getRandNum()
For i = 1 To 3 - Len("" & txtNum)
txtNum = "0" & txtNum
Next
txtNum1.Caption = Mid(txtNum, 1, 1)
txtNum2.Caption = Mid(txtNum, 2, 1)
txtNum3.Caption = Mid(txtNum, 3, 1)
Image1.Picture = LoadPicture(App.path & "/images/" & txtNum1.Caption & ".jpg")
Image2.Picture = LoadPicture(App.path & "/images/" & txtNum2.Caption & ".jpg")
Image3.Picture = LoadPicture(App.path & "/images/" & txtNum3.Caption & ".jpg")
Select Case prizeType
Case 1
upNum = 8
allNum = firstCount
prizeName = "一等奖"
Case 2
upNum = 5
allNum = secondCount
prizeName = "二等奖"
Case 3
upNum = -1
allNum = thirdCount
prizeName = "三等奖"
Case 4
upNum = -1
allNum = specialCount
prizeName = "特等奖"
End Select
lbStatus.Caption = "正在抽取第" & (curIndex + 1) & "个" & prizeName & "..."
End Sub
Function getRandNum()
Dim randNum As Integer
Dim isInList As Boolean
isInList = False
Do While True
Randomize
randNum = Int((allCount * Rnd) + 1) '产生1到188之间的随机数
isInList = False
For i = 1 To firstCount
If randNum = CInt("0" & prizeFirstNum(i)) Then isInList = True
Next
For i = 1 To secondCount
If randNum = CInt("0" & prizeSecondNum(i)) Then isInList = True
Next
For i = 1 To thirdCount
If randNum = CInt("0" & prizeThirdNum(i)) Then isInList = True
Next
For i = 1 To specialCount
If randNum = CInt("0" & prizeSpecialNum(i)) Then isInList = True
Next
If Not isInList Then Exit Do
Loop
getRandNum = randNum
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -