首先謝謝各位大神，
抽獎系統是用VB撰寫的，獎品在C:\program Files\Microsoft Visual Studio\WFJ.TXT (wfj.txt里) 現在狀況是按空格或者確定鍵會隨機從wfj.txt里抽取獎品，我想修改代碼設定一個特定鍵，按了之后會指定顯示wfj.txt的第一行！代碼如下
FORM1代碼
Option Explicit
Dim gradeshu, filenum, num, filenum1, exit1 As Integer
Dim nextline, abcd, abcde, abcdef As String
Private Sub loadlist1(nextline As String)
Dim num1, i As Integer
num1 = Int(Mid(nextline, InStr(nextline, "/") + 1, InStr(nextline, " ") - InStr(nextline, "/") - 1)) - Int(Mid(nextline, InStr(nextline, "：") + 1, InStr(nextline, "/") - InStr(nextline, "：") - 1))
For i = 1 To num1
List1.AddItem (Trim(Mid(nextline, InStr(nextline, " "))))
Next
End Sub
Private Sub b_Click()
Dim str2 As String
Dim ab
str2 = ""
filenum1 = FreeFile
Open "c:\program Files\Microsoft Visual Studio\wfj.txt" For Input As filenum1
Do While Not EOF(filenum1)
Line Input #filenum1, nextline
If Trim(nextline) <> "" Then str2 = str2 + " " + Trim(Mid(nextline, InStr(nextline, "：") + 1)) + " " + vbCr
Loop
Close filenum1
ab = MsgBox(str2, vbOKOnly, "中獎人數")
End Sub
Private Sub c_Click()
End
End Sub
Private Sub d_Click()
Form2.Show
End Sub
Private Sub Form_Activate()
gradeshu = 0
List1.Clear
List2.Clear
filenum = FreeFile
Open "c:\program Files\Microsoft Visual Studio\wfj.txt" For Input As filenum
Do While Not EOF(filenum)
Line Input #filenum, nextline
nextline = Trim(nextline)
If nextline <> "" Then
gradeshu = gradeshu + 1
loadlist1 (nextline)
List2.AddItem (Trim(Mid(nextline, InStr(nextline, " "))))
End If
Loop
Close filenum
If List1.ListCount < 49 Then
If exit1 = 1 Then End
MsgBox (" 中獎名額少于50，抽獎結束，增加名額方可繼續進行！ ")
Form2.Show
exit1 = exit1 + 1
End If
start.Enabled = False
End Sub
Private Sub Form_Load()
exit1 = 0
End Sub
Private Sub abc()
start.Enabled = True: start.SetFocus: Call start_Click
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Form1.PopupMenu a
If Button = 1 Then Call abc
End Sub
Private Sub Label2_Click()
Call abc
End Sub
Private Sub Label4_Click()
Call abc
End Sub
Private Sub Label5_Click()
Call abc
End Sub
Private Sub pause_Click()
Dim i As Integer
Dim str1(0 To 30) As String
Dim a, str2, num1 As String
pause.Enabled = False
Timer1.Enabled = False
Randomize
i = Int(List1.ListCount * Rnd(1))
a = Trim(List1.List(i))
Label4.Caption = vbCr + a
List1.RemoveItem (i)
i = 0
filenum = FreeFile
Open "c:\program Files\Microsoft Visual Studio\wfj.txt" For Input As filenum
Do While Not EOF(filenum)
Line Input #filenum, nextline
If Trim(nextline) <> "" Then str1(i) = Trim(nextline): i = i + 1
Loop
Close filenum
filenum = FreeFile
Open "c:\program Files\Microsoft Visual Studio\wfj.txt" For Output As filenum
For i = 0 To gradeshu - 1
If a = Trim(Mid(str1(i), InStr(str1(i), " "))) Then
Label5.Caption = Mid(str1(i), 1, 3)
num1 = Int(Mid(str1(i), InStr(str1(i), "：") + 1, InStr(str1(i), "/") - InStr(str1(i), "：") - 1)) + 1
str1(i) = Mid(str1(i), 1, InStr(str1(i), "：")) + num1 + Mid(str1(i), InStr(str1(i), "/"))
End If
Print #filenum, str1(i)
Next
Close filenum
num = 0
End Sub
Private Sub start_Click()
If List1.ListCount = 99 Then MsgBox (" 中獎名額少于100，通知營銷策劃部增加名額！ ")
If List1.ListCount = 79 Then MsgBox (" 中獎名額少于80，通知營銷策劃部增加名額！ ")
If List1.ListCount = 49 Then MsgBox (" 中獎名額少于50，抽獎結束，增加名額方可繼續進行！ "): Exit Sub
start.Enabled = False
pause.Enabled = True
pause.SetFocus
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
Randomize
Label4.Caption = vbCr + List2.List(Int(gradeshu * Rnd(2)))
End Sub
FORM2代碼
Option Explicit
Dim filenum As Integer
Dim nextline As String
Private Sub Command1_Click()
Dim str As String
If Trim(Text1.Text) = "24680" Then
str = Trim(RichTextBox1.Text) + vbCrLf
filenum = FreeFile
Open "c:\program Files\Microsoft Visual Studio\wfj.txt" For Output As filenum
Do While Len(str) > 8
Print #filenum, Mid(str, 1, InStr(str, vbCrLf) - 1)
str = Mid(str, InStr(str, vbCrLf) + 2)
Loop
Close #filenum
MsgBox (" 獎項設定保存成功！ ")
Text1.Text = ""
Command2.SetFocus
Else
MsgBox " 密碼不正確 ！ ", , "提示": Text1.Text = "": Text1.SetFocus
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
RichTextBox1.Text = " "
filenum = FreeFile
Open "c:\program Files\Microsoft Visual Studio\wfj.txt" For Input As filenum
Do While Not EOF(filenum)
Line Input #filenum, nextline
nextline = Trim(nextline)
If nextline <> "" Then
RichTextBox1.Text = RichTextBox1.Text + nextline + vbCrLf + " "
End If
Loop
Close #filenum
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
If Trim(Text1.Text) = "24680" Then
Command1.Enabled = True
RichTextBox1.Visible = True
Command1.SetFocus
Else
MsgBox " 密碼不正確 ！ ", , "提示"
Text1.Text = ""
End If
End If
End Sub
uj5u.com熱心網友回復：
自己頂貼！！uj5u.com熱心網友回復：
你這代碼，看的都暈................從txt到陣列，2行代碼就搞定（一個定義陳述句，一個讀取和分解陳述句）
請參考：
Option Explicit
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 32 ''space
Label1.Caption = ReturnJP
Case 49 ''0
Case 65 ''a
Select Case Shift
Case 1 ''shift+a
Case 2 ''ctrl+a
Case 4 ''alt+a
End Select
End Select
End Sub
Function ReturnJP() As String
''要參考microsoft scripting runtime
On Error Resume Next
Dim FSO As New FileSystemObject, i As Integer, ww
ww = Split(FSO.GetFile("d:\idx.txt").OpenAsTextStream.ReadAll, vbCrLf)
If UBound(ww) > -1 Then
Randomize
i = Int(Rnd * (UBound(ww) + 1))
ReturnJP = ww(i)
Else
ReturnJP = "沒有內容！"
End If
End Function
...
uj5u.com熱心網友回復：
啊，把那個函式改一下：Function ReturnJP() As String
''要參考microsoft scripting runtime
On Error Resume Next
Dim FSO As New FileSystemObject, i As Integer, ww
ww = Split(FSO.GetFile("d:\idx.txt").OpenAsTextStream.ReadAll, vbCrLf)
ReturnJP = "沒有內容！"''默認值
If UBound(ww) > -1 Then
Randomize
i = Int(Rnd * (UBound(ww) + 1))
ReturnJP = ww(i)
End If
End Function
uj5u.com熱心網友回復：
作弊是吧?form里面添加keydown的代碼就好
你的代碼我懶得看
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
把你要作弊的那個文字顯示到桌面上
end if
End Sub
這里的KeyAscii = 13 就是你作弊的時候按的鍵的ascii碼值,13是回車,表示回車就開始作弊了
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/80910.html
標籤：VB基礎類
上一篇：怎樣在vs2010中定義定長字串
下一篇：采用post登錄網站問題