数字排序小游戏
Option Explicit
Dim Label2X As Integer '记录标签控件数组中要移动的标签控件左上角X的位置
Dim Label2Y As Integer '记录标签控件数组中要移动的标签控件左上角Y的位置
'让标签数组中的每个标签控件上显示的数字是随机的，无重复的
Private Sub Init()
Randomize
Dim a(7) As Integer
Dim i As Integer, k As Integer
Label1.Caption = ""
For i = 0 To 7
a(i) = i
Next
For i = 0 To 7
k = Int(Rnd * 8)
Do While a(k) = -1 'a(k)=-1表示该数组元素对应的数字已经被使用过了
k = Int(Rnd * 8) '重新生成k的值，直到a(k)的值不等于-1
Loop
Label2(i).Caption = Trim(Str(a(k)))
a(k) = -1 'a(k)的值已经使用了，不能再用，重新赋值为-1与其他的元素值相区别
Next i
End Sub
Private Sub Command1_Click()
Dim x As Integer, y As Integer
Dim z As Integer
Init
Picture1.Enabled = True
'让空白标签Label1出现的位置随机
Randomize
'记录下空白标签Label1的位置
x = Label1.Left
y = Label1.Top
z = Int(Rnd * 8)
'将空白标签Label1和标签控件数组任一控件交换位置
Label1.Move Label2(z).Left, Label2(z).Top
Label2(z).Move x, y
Command1.Enabled = False
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Dim i As Integer
Picture1.Enabled = False
'在标签中显示游戏说明信息
Label3.Caption = "如左图所示，将数字按0-7顺" & vbCrLf & vbCrLf & "序依次排列，即取得胜利。"
'在标签中显示排列规则后的数字顺序
Label1.Caption = 0
For i = 0 To 6
Label2(i).Caption = i + 1
Next
End Sub
Private Sub Label1_DragDrop(Source As Control, x As Single, y As Single)
Dim Label1X As Integer '记录空白控件Label1左上角X的位置
Dim Label1Y As Integer '记录空白控件Label1左上角Y的位置
Dim flag(3) As Boolean
'获取空白控件Label1的位置
Label1X = Label1.Left
Label1Y = Label1.Top
'要移动的控件位于空白控件Label1的正左侧
flag(0) = (Label2X = Label1X - Source.Width) And (Label2Y = Label1Y)
'要移动的控件位于空白控件Label1的正右侧
flag(1) = (Label2X = Label1X + Source.Width) And (Label2Y = Label1Y)
'要移动的控件位于空白控件Label1的正上方
flag(2) = (Label2X = Label1X) And (Label2Y = Label1Y - Source.Height)
'要移动的控件位于空白控件Label1的正下方
flag(3) = (Label2X = Label1X) And (Label2Y = Label1Y + Source.Height)
If flag(0) Or flag(1) Or flag(2) Or flag(3) Then
Label1.Move Label2X, Label2Y
Source.Move Label1X, Label1Y
End If
Win
End Sub
Private Sub Label2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then '如果按下鼠标左键
'记录下要拖动控件的位置
Label2X = Label2(Index).Left
Label2Y = Label2(Index).Top
Label2(Index).Drag 1 '启动拖动操作
End If
End Sub
Private Sub Label2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Label2(Index).Drag 2 '结束拖动操作
End Sub
Private Sub Win()
Dim winner As Integer
Dim i As Integer
Dim answer As Integer
'对于给定的标签控件数组中的任一标签控件，可以落在符合要求(对应位置应显示对应数字）
'的八个位置中的任一位置
'利用循环语句对标签控件数组中的每个标签控件进行检查，如果其落在某一符号要求的位置，
'则变量winner的值加1，如果所有标签控件都落在符号要求的位置，则变量winner的值应为8
For i = 0 To 7
If Label2(i).Left = 0 And Label2(i).Top = 0 And _
Label2(i).Caption = 0 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 0 And _
Label2(i).Caption = 1 Then
winner = winner + 1
ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = 0 And _
Label2(i).Caption = 2 Then
winner = winner + 1
ElseIf Label2(i).Left = 0 And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 3 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 4 Then
winner = winner + 1
ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 5 Then
winner = winner + 1
ElseIf Label2(i).Left = 0 And Label2(i).Top = 2 * Label2(i).Height And _
Label2(i).Caption = 6 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 2 * Label2(i).Height And _
Label2(i).Caption = 7 Then
winner = winner + 1
End If
Next i
If winner = 8 Then
MsgBox " 恭喜您，胜利了！", 0 + 64 + 0, "提示"
Picture1.Enabled = False
answer = MsgBox("还继续吗？", 4 + 32 + 0, "提示")
If answer = vbYes Then
Command1.Enabled = True
Else
End
End If
End If
End Sub
弹球游戏
Dim x_step As Integer
Dim y_step As Integer
Private Sub command1_Click()
If Timer1.Enabled = True Then
Timer1.Enabled = False
Else
Timer1.Enabled = True
End If
If command1.Caption = "暂停" Then
command1.Caption = "继续"
Else
command1.Caption = "暂停"
End If
End Sub
Private Sub Form_Load()
x_step = 200
y_step = 200
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 37 Then
If Line1.X1 < 0 Then
Line1.X1 = 0: Line1.X2 = 2000
Else
Line1.X1 = Line1.X1 - 100: Line1.X2 = Line1.X2 - 100
End If
End If
If KeyCode = 39 Then
If Line1.X1 > Picture1.Width Then
Line1.X1 = Picture1.Width - 2000: line2.X2 = Picture.Width
Else
Line1.X1 = Line1.X1 + 100: Line1.X2 = Line1.X2 + 100
End If
End If
End Sub
Private Sub Timer1_Timer()
If Shape1.Top < 0 Then
Shape1.Top = 0: y_step = -y_step
End If
If Shape1.Left < 0 Then
Shape1.Left = 0
x_step = -x_step
End If
If Shape1.Left > Picture1.Width - Shape1.Width Then
Shape1.Left = Picture1.Width - Shape1.Width
x_step = -x_step
End If
If Shape1.Left >= Line1.X1 And Shape1.Left <= Line1.X2 And Shape1.Top >= Line1.Y1 - Shape1.Height Then
Shape1.Top = Line1.Y1 - Shape1.Height
y_step = -y_step * 1.01
x_step = x_step * 1.01
Label2.Caption = Label2.Caption + 1
End If
Shape1.Top = Shape1.Top + y_step
Shape1.Left = Shape1.Left + x_step
If Shape1.Top >= Picture1.Height - Shape1.Height Then
MsgBox "游戏结束"
command1.Caption = "开始"
Timer1.Enabled = False
Shape1.Top = 1000
Label2.Caption = 0
End If
End Sub
打字游戏
Dim score As Integer
Dim speed As Integer
Dim typetime As Integer
Private Sub init()
Randomize
lblletter1.Caption = Chr(Int(Rnd * 42) + 48)
lblletter1.Left = Int(Rnd * 2800) + 1
lblletter1.Top = 0
End Sub
Private Sub init1()
Randomize
lblletter2.Caption = Chr(Int(Rnd * 25) + 97)
lblletter2.Left = Int(Rnd * 2800) + 1
lblletter2.Top = 0
End Sub
Private Sub Command1_Click()
score = Int(lblscore.Text)
init
init1
Timer1 = True
Timer2 = True
HScroll1.Enabled = False
Command1.Enabled = False
Command2.Enabled = False
HScroll1.Enabled = False
If lbltime.Text <= 0 Then
Timer1 = False
Timer2 = False
lblletter1.Caption = ""
lblletter2.Caption = ""
End If
End Sub
Private Sub Command2_Click()
typetime = InputBox("请输入打字时间。", "时间设置")
If typetime <= 0 Then
lbltime.Text = 60
End If
lbltime.Text = typetime
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = lblletter1.Caption Then
score = score + 1
lblscore.Text = score
init
End If
If Chr(KeyAscii) = lblletter2.Caption Then
score = score + 1
lblscore.Text = score
init1
End If
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Timer2.Enabled = False
lblletter1.AutoSize = True
lblletter2.AutoSize = True
lblletter1.Caption = ""
lblletter2.Caption = ""
lblscore.Text = 0
lblspeed.Caption = 100
lbltime.Text = 60
HScroll1.Max = 200
HScroll1.Min = 20
HScroll1.SmallChange = 5
HScroll1.LargeChange = 20
HScroll1.Value = 100
End Sub
Private Sub HScroll1_Change()
lblspeed.Caption = HScroll1.Value
End Sub
Private Sub Timer1_Timer()
lblletter1.Top = lblletter1.Top + lblspeed.Caption
If lblletter1.Top >= 4335 Then
Call init
End If
lblletter2.Top = lblletter2.Top + lblspeed.Caption
If lblletter2.Top >= 4335 Then
Call init1
End If
End Sub
Private Sub Timer2_Timer()
If lbltime.Text > 0 Then
lbltime.Text = lbltime.Text - 1
Else: Select Case score / (typetime / 60)
Case Is <= 40
MsgBox ("不要放弃再试一次！")
Case 40 To 80
MsgBox ("太棒了，继续努力！")
Case 80 To 120
MsgBox ("坚持下去，你将成为一个打字高手！")
Case Is > 120
MsgBox ("祝贺你！你已经是一个打字高手！")
End Select
Timer1 = False
Timer2 = False
HScroll1.Enabled = True
Command1.Enabled = True
Command2.Enabled = True
HScroll1.Enabled = True
init
init1
End If
End Sub
点灯游戏
Private Sub Form_Load()
Form1.Scale (0, 12)-(12, 0)
For i = 1 To 11
Line (1, i)-(11, i)
Line (i, 1)-(i, 11)
Next i
End Sub
Sub fill_color(X, Y)
If Point(X, Y) = vbWhite Then
Line (Int(X), Int(Y))-(Int(X + 1), Int(Y + 1)), vbBlack, BF
Else
Line (Int(X), Int(Y))-(Int(X + 1), Int(Y + 1)), vbWhite, BF
End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X >= 1 And X <= 11 And Y >= 1 And Y <= 11 Then
Call fill_color(X, Y)
If X >= 1 And X <= 11 And Y + 1 >= 1 And Y + 1 <= 11 Then
Call fill_color(X, Y + 1)
End If
If X >= 1 And X <= 11 And Y - 1 >= 1 And Y - 1 <= 11 Then
Call fill_color(X, Y - 1)
End If
If X + 1 >= 1 And X + 1 <= 11 And Y >= 1 And Y <= 11 Then
Call fill_color(X + 1, Y)
End If
If X - 1 >= 1 And X - 1 <= 11 And Y >= 1 And Y <= 11 Then
Call fill_color(X - 1, Y)
End If
End If
Call Form_Load
End Sub
猜数字
Dim number As Integer
Private Sub Command1_Click()
Dim guess As Integer, diff As Integer
guess = Val(Text1.Text)
If guess = -1 Then
MsgBox ("要猜的数是" & number)
Text1.Text = ""
Text1.SetFocus
Exit Sub
End If
diff = Abs(number - guess)
Select Case diff
Case 0
MsgBox ("恭喜你猜对了！")
Case 2, Is < 2
MsgBox ("接近了，再努力！")
Case 10, Is < 12
MsgBox ("有些远，再努力！")
Case Else
MsgBox ("太远了，继续努力！")
End Select
Select Case diff
Case Is <> 0
Text1.Text = ""
Text1.SetFocus
End Select
End Sub
Private Sub Form_Load()
MsgBox ("计算机产生了一个1~100之间的整数，" & Chr(10) & "请您猜出这个数是多少。" & Chr(10) & "如果输入-1，则停止猜数，并输出要猜的数。")
number = Int(100 * Rnd) + 1
End Sub
Private Sub Label1_Click()
End Sub
猜笑脸
Private Sub Command1_Click(Index As Integer)
Dim a As Integer, i As Integer
Randomize
a = Int(Rnd * 4)
Command1(a).Enabled = False
Command1(a).DisabledPicture = LoadPicture("267.gif")
If a = Index Then
Label1.Caption = "你猜对啦，真棒！"
Else
Label1.Caption = "你猜错啦，我在这哩！"
End If
For i = 0 To 3
Command1(i).Enabled = False
Next i
End Sub
Private Sub Command2_Click()
Dim i As Integer
For i = 0 To 3
Command1(i).Enabled = True
Command1(i).DisabledPicture = LoadPicture("")
Next i
Label1.Caption = "猜猜我在哪儿？"
End Sub
Private Sub Command3_Click()
End
End Sub
Option Explicit
Dim Label2X As Integer '记录标签控件数组中要移动的标签控件左上角X的位置
Dim Label2Y As Integer '记录标签控件数组中要移动的标签控件左上角Y的位置
'让标签数组中的每个标签控件上显示的数字是随机的，无重复的
Private Sub Init()
Randomize
Dim a(7) As Integer
Dim i As Integer, k As Integer
Label1.Caption = ""
For i = 0 To 7
a(i) = i
Next
For i = 0 To 7
k = Int(Rnd * 8)
Do While a(k) = -1 'a(k)=-1表示该数组元素对应的数字已经被使用过了
k = Int(Rnd * 8) '重新生成k的值，直到a(k)的值不等于-1
Loop
Label2(i).Caption = Trim(Str(a(k)))
a(k) = -1 'a(k)的值已经使用了，不能再用，重新赋值为-1与其他的元素值相区别
Next i
End Sub
Private Sub Command1_Click()
Dim x As Integer, y As Integer
Dim z As Integer
Init
Picture1.Enabled = True
'让空白标签Label1出现的位置随机
Randomize
'记录下空白标签Label1的位置
x = Label1.Left
y = Label1.Top
z = Int(Rnd * 8)
'将空白标签Label1和标签控件数组任一控件交换位置
Label1.Move Label2(z).Left, Label2(z).Top
Label2(z).Move x, y
Command1.Enabled = False
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Dim i As Integer
Picture1.Enabled = False
'在标签中显示游戏说明信息
Label3.Caption = "如左图所示，将数字按0-7顺" & vbCrLf & vbCrLf & "序依次排列，即取得胜利。"
'在标签中显示排列规则后的数字顺序
Label1.Caption = 0
For i = 0 To 6
Label2(i).Caption = i + 1
Next
End Sub
Private Sub Label1_DragDrop(Source As Control, x As Single, y As Single)
Dim Label1X As Integer '记录空白控件Label1左上角X的位置
Dim Label1Y As Integer '记录空白控件Label1左上角Y的位置
Dim flag(3) As Boolean
'获取空白控件Label1的位置
Label1X = Label1.Left
Label1Y = Label1.Top
'要移动的控件位于空白控件Label1的正左侧
flag(0) = (Label2X = Label1X - Source.Width) And (Label2Y = Label1Y)
'要移动的控件位于空白控件Label1的正右侧
flag(1) = (Label2X = Label1X + Source.Width) And (Label2Y = Label1Y)
'要移动的控件位于空白控件Label1的正上方
flag(2) = (Label2X = Label1X) And (Label2Y = Label1Y - Source.Height)
'要移动的控件位于空白控件Label1的正下方
flag(3) = (Label2X = Label1X) And (Label2Y = Label1Y + Source.Height)
If flag(0) Or flag(1) Or flag(2) Or flag(3) Then
Label1.Move Label2X, Label2Y
Source.Move Label1X, Label1Y
End If
Win
End Sub
Private Sub Label2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then '如果按下鼠标左键
'记录下要拖动控件的位置
Label2X = Label2(Index).Left
Label2Y = Label2(Index).Top
Label2(Index).Drag 1 '启动拖动操作
End If
End Sub
Private Sub Label2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Label2(Index).Drag 2 '结束拖动操作
End Sub
Private Sub Win()
Dim winner As Integer
Dim i As Integer
Dim answer As Integer
'对于给定的标签控件数组中的任一标签控件，可以落在符合要求(对应位置应显示对应数字）
'的八个位置中的任一位置
'利用循环语句对标签控件数组中的每个标签控件进行检查，如果其落在某一符号要求的位置，
'则变量winner的值加1，如果所有标签控件都落在符号要求的位置，则变量winner的值应为8
For i = 0 To 7
If Label2(i).Left = 0 And Label2(i).Top = 0 And _
Label2(i).Caption = 0 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 0 And _
Label2(i).Caption = 1 Then
winner = winner + 1
ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = 0 And _
Label2(i).Caption = 2 Then
winner = winner + 1
ElseIf Label2(i).Left = 0 And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 3 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 4 Then
winner = winner + 1
ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 5 Then
winner = winner + 1
ElseIf Label2(i).Left = 0 And Label2(i).Top = 2 * Label2(i).Height And _
Label2(i).Caption = 6 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 2 * Label2(i).Height And _
Label2(i).Caption = 7 Then
winner = winner + 1
End If
Next i
If winner = 8 Then
MsgBox " 恭喜您，胜利了！", 0 + 64 + 0, "提示"
Picture1.Enabled = False
answer = MsgBox("还继续吗？", 4 + 32 + 0, "提示")
If answer = vbYes Then
Command1.Enabled = True
Else
End
End If
End If
End Sub
弹球游戏
Dim x_step As Integer
Dim y_step As Integer
Private Sub command1_Click()
If Timer1.Enabled = True Then
Timer1.Enabled = False
Else
Timer1.Enabled = True
End If
If command1.Caption = "暂停" Then
command1.Caption = "继续"
Else
command1.Caption = "暂停"
End If
End Sub
Private Sub Form_Load()
x_step = 200
y_step = 200
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 37 Then
If Line1.X1 < 0 Then
Line1.X1 = 0: Line1.X2 = 2000
Else
Line1.X1 = Line1.X1 - 100: Line1.X2 = Line1.X2 - 100
End If
End If
If KeyCode = 39 Then
If Line1.X1 > Picture1.Width Then
Line1.X1 = Picture1.Width - 2000: line2.X2 = Picture.Width
Else
Line1.X1 = Line1.X1 + 100: Line1.X2 = Line1.X2 + 100
End If
End If
End Sub
Private Sub Timer1_Timer()
If Shape1.Top < 0 Then
Shape1.Top = 0: y_step = -y_step
End If
If Shape1.Left < 0 Then
Shape1.Left = 0
x_step = -x_step
End If
If Shape1.Left > Picture1.Width - Shape1.Width Then
Shape1.Left = Picture1.Width - Shape1.Width
x_step = -x_step
End If
If Shape1.Left >= Line1.X1 And Shape1.Left <= Line1.X2 And Shape1.Top >= Line1.Y1 - Shape1.Height Then
Shape1.Top = Line1.Y1 - Shape1.Height
y_step = -y_step * 1.01
x_step = x_step * 1.01
Label2.Caption = Label2.Caption + 1
End If
Shape1.Top = Shape1.Top + y_step
Shape1.Left = Shape1.Left + x_step
If Shape1.Top >= Picture1.Height - Shape1.Height Then
Pr
4399. 7k7k. spnk
内容全部来源于网络收集，如有侵权，请联系网站删除：QQ：24596024