|
近年來在娛樂節目之中常常見到利用電腦來抽獎，筆者對其發生了興趣遂自己動手用VB編了一個小程序來實現電腦抽獎的小功能，其原理如下：
主要利用VB中的Rnd函數，來實現隨機查找和打亂排序的功能，從而實現隨機抽獎的目的。Rnd函數的語法結構是Rnd[(number)]，可選的number參數是 single或任何有效的數值表達式。Rnd函數返回小于1但大于或等于0的值。number 的值決定了 Rnd 生成隨機數的方式。為了生成某個范圍內的隨機整數，可使用以下公式：
Int((upperbound － lowerbound ＋ 1) × Rnd ＋ lowerbound)
這里，upperbound 是隨機數范圍的上限，而 lowerbound 則是隨機數范圍的下限。
另外，程序中還使用了INI文件，Windows INI文件,可解釋為Windows初始化文件。它是一種專門用來保存應用程序初始化信息和運行環境信息的文本文件。ini文件是一種文本文件,它可以通過Notepad等文本編輯器進行編輯。ini文件具有特定的格式。一個INI文件是由若干個段(section)組成的,每個段中包含若干關鍵字(key)及相應的值(value)。創建應用程序自己的INI文件,通過INI文件保存應用程序的一些運行環境信息,然后在程序中讀取INI文件中的設置信息并據以處理。一旦程序的運行環境需要變更,則可以通過直接修改INI文件，或在程序中提供專門的界面間接地修改INI文件來保證程序的可用性。
源程序及注釋如下：
'窗體源程序
Option Explicit
Dim m_strNameArray() As MyName
Dim m_bIsStart As Boolean
Dim m_nNameIndex As Integer
Dim MAX_INDEX As Integer
Dim m_nSelectNum As Integer
'被選定數
Dim nScrollStep As Integer
Dim nScrollWidth As Integer
Dim bScrollState As Boolean
Dim nEnableSecond As Integer
Dim m_strTitle As String
Dim m_strAppTitle As String
Dim m_strScrollTitleLeft As String
Dim m_strScrollTitleRight As String
Private Sub Command_Start_Stop_Click()
If m_bIsStart = True Then
'按停止鈕
m_bIsStart = False
Command_Start_Stop.Caption =
“開始"
Label_FlashName.Visible = True
Timer_FlashName.Enabled = True
Timer_ScrollName.Enabled = False
Label_FlashName =
m_strNameArray（m_nNameIndex).strName ＋ “中獎了！"
m_strNameArray(m_nNameIndex).bIsSelect = True
m_nSelectNum = m_nSelectNum ＋ 1
Dim Temp As MyName
Temp =m_strNameArray(MAX_INDEX)
m_str Name Array(MAX－INDEX) = m_strNameArray(m_nNameIndex)
m_strNameArray(m_nNameIndex) =Temp
MAX_INDEX = MAX_INDEX － 1
If MAX_INDEX = 0 Then
MsgBox “非常感謝您使用本軟件"
End If
Else '按開始鈕
m_bIsStart = True
Command_Start_Stop.Caption = “停止"
Command_Start_Stop.Enabled = False
Timer_ScrollName.Enabled = True
Timer_FlashName.Enabled = False
Label_FlashName.Caption = “"
End If
End Sub
Private Sub Form_Load()
Form_Bouns.ScaleMode = 3
m_nNameIndex = 0
m_bIsStart = False
Timer_ScrollName.Enabled = True
Timer_ScrollTitle.Enabled = True
Label_FlashName.Visible = False
Label_ScrollName.Caption = “"
nEnableSecond = 0
'定義起始秒數
ReDimNameArray
'獲得文本中的名字和打亂名字順序
nScrollStep = 5 '設定滾動字的步長
nScrollWidth = Label_Congruation.Left
'設定title的移動寬度
bScrollState = False
'設定缺省的開始滾動方向為向左
m_nSelectNum = 0
'初始化被選定數為0
Init
'初始化本程序的界面
End Sub
Private Sub Timer_FlashName_Timer() '閃動中獎者姓名
If Label_FlashName.Visible = True Then
Label_FlashName.Visible = False
Else
Label_FlashName.Visible = True
End If
End Sub
Private Sub Timer_ScrollName_Timer() '滾動出現名字
If m_bIsStart = True Then
If m_nNameIndex >= MAX_INDEX Then
m_nNameIndex = 0
End If
m_nNameIndex =m_nNameIndex ＋ 1
If m_strNameArray(m_nNameIndex).bIsSelect = True Then
If m_nNameIndex < MAX－INDEX Then
m_nNameIndex =
m_nNameIndex ＋ 1
Else
m_nNameIndex = 0
End If
End If
Label_ScrollName.Caption = m_str
NameArray(m_nNameIndex).strName
'End If
End If
End Sub
Private Sub Timer_ScrollTitle_Timer() '滾動“恭喜發財"字樣
If bScrollState = False Then '向左滾
nScrollStep = 10
Label_Congruation.Caption = m_strScrollTitleLeft
If nScrollWidth > 0 Then
nScrollWidth =
nScrollWidth － nScrollStep
Else
bScrollState = True
End If
Else '向右滾
nScrollStep = －10
Label_Congruation.Caption =
m_strScrollTitleRight
If nScrollWidth < Form_Bouns.ScaleWidth －
Label_Congruation.Width Then
nScrollWidth =
nScrollWidth － nScrollStep
Else
bScrollState = False
End If
End If
Label_Congruation.Left = nScrollWidth
'以下為8秒鐘內使“停止"按鈕有效
If nEnableSecond <= 49 Then
If m_bIsStart = True Then
nEnableSecond =nEnableSecond ＋ 1
End If
Else
If m_bIsStart = True Then
Command_Start_Stop.Enabled = True
nEnableSecond = 0
End If
End If
End Sub
'動態定義數組
Private Sub ReDimNameArray()
Dim nMaxIndex As Integer
Dim strMaxIndex As String
Dim nIndex As Integer
Dim bIsBegin As Boolean
bIsBegin = False
nIndex = 0
Open App.Path ＋ “\name.txt" For Input As ＃1 '讀文件
Do Until EOF(1)
If bIsBegin = False Then
Line Input ＃1, strMaxIndex
nMaxIndex = Val(strMaxIndex)
MAX_INDEX = nMaxIndex － 1
ReDim m_strNameArray(0 To nMaxIndex － 1)
bIsBegin = True
Else
Line Input ＃1, m_strNameArray(nIndex).strName
m_strNameArray(nIndex).bIsSelect = False
nIndex = nIndex ＋ 1
End If
Loop
'以下為打亂人員順序10次
Dim i As Integer
Dim j As Integer
Dim Temp As String
Dim nRandomNum As Integer
For j = 0 To 10
For i = 0 To nMaxIndex － 1
nRandomNum = ((nMaxIndex － 1) × Rnd) '利用Rnd函數
Temp = m_strNameArray(i).strName
m_strNameArray(i).strName = m_strNameArray(nRandomNum).strName
m_strNameArray(nRandomNum).strName = Temp
Next i
Next j
End Sub
Private Sub Init() '讀取INI文件
Dim X As Long
Dim lpFileName
Dim Temp As String × 50
lpFileName = App.Path ＋ “\Sortition.ini"
X = GetPrivateProfileString(“SYSTEM",“AppTitle",“抽獎程序", Temp, Len(Temp), lpFileName)
m_strAppTitle = Trim(Temp)
Temp =“"
X = GetPrivateProfileString(“SYSTEM", "Title", "歡迎使用抽獎程序", Temp, Len(Temp), lpFileName)
m_strTitle = Trim(Temp)
Temp = “"
X = GetPrivateProfileString(“SYSTEM",“ScrollTitleRight", “恭喜發財!!!", Temp, Len(Temp), lpFileName)
m_strScrollTitleRight = Trim(Temp)
X = GetPrivateProfileString(“SYSTEM",“ScrollTitleLeft", “龍年大發!!!", Temp, Len(Temp), lpFileName)
m_strScrollTitleLeft = Trim(Temp)
Form_Bouns.Caption = m_strAppTitle
Label_CompanyTitle.Caption = m_strTitle
End Sub
模塊源程序：
'用于讀取ini文件的API函數
Declare Function GetPrivateProfileString Lib “kernel32" Alias “GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Type MyName
strName As String
bIsSelect As Boolean
End Type
由于程序利用的windows ini文件保存一些標題信息，因而可以方便的修改使用環境,及標題內容。
見ini文件內容：
[SYSTEM]
;應用程序的form名稱
AppTitle=“風云電腦抽獎Test"
;窗口的內的標題(限9個字)
Title=“大抽獎"
;右滾動的文字(僅能為如下格式:XXXX!!!)
ScrollTitleRight=“恭喜發財!!!"
;左滾動的文字(僅能為如下格式:XXXX!!!)
ScrollTitleLeft=“祝您好運!!!"
如此一個小小的電腦抽獎程序便完成了。
以上程序在VB6.0 Windows98環境下編譯通過
|
