excel做的射击游戏(射中有奖励看PP)

HHAAMM

 

点击按钮开始，再次点击结束

点击键盘方向右键，弓箭向右移动

点击键盘方向左键，弓箭向左移动

点击键盘方向上键，发射弓箭

 

射中有奖励哦[em02]

代码

Dim x%, x1%, y%, y1%, a%, b%
Private Sub CommandButton1_Click()
If CommandButton1.Caption = "结束" Then
    CommandButton1.Caption = "开始"
    b = 0
    头像
Else
    CommandButton1.Caption = "结束"
    b = 1
End If
End Sub

Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If CommandButton1.Caption = "结束" Then Exit Sub
If KeyCode = 37 Then
    ActiveSheet.Shapes("Image1").IncrementLeft -11
    ActiveSheet.Shapes("Image2").Top = ActiveSheet.Shapes("Image1").Top
    ActiveSheet.Shapes("Image2").Left = ActiveSheet.Shapes("Image1").Left + ActiveSheet.Shapes("Image1").Width / 2 - 6.6
 
    VBA.DoEvents
    a = 0
End If
If KeyCode = 38 Then
    a = 0
    子弹
End If
If KeyCode = 39 Then
    ActiveSheet.Shapes("Image1").IncrementLeft 11
    ActiveSheet.Shapes("Image2").Top = ActiveSheet.Shapes("Image1").Top
    ActiveSheet.Shapes("Image2").Left = ActiveSheet.Shapes("Image1").Left + ActiveSheet.Shapes("Image1").Width / 2 - 6.6
 
    VBA.DoEvents
End If
End Sub

Sub 子弹()
Static m%
x = ActiveSheet.Shapes("Image2").Top
x1 = ActiveSheet.Shapes("Image2").Left
y = ActiveSheet.Shapes("Picture 5").Top
y1 = ActiveSheet.Shapes("Picture 5").Left
If x = 0 Then Exit Sub
If Abs(x + 10 - (y + 10)) <= 10 Then
If Abs(x1 + 10 - (y1 + 10)) <= 10 Then
    If m = 10 Then m = 0
    m = m + 1
    ActiveSheet.Shapes("Picture " & 18 + m).Top = 100
    ActiveSheet.Shapes("Picture " & 18 + m).Left = 200
    ActiveSheet.Shapes("Picture " & 18 + m).Width = 100
    PauseTime = 0.7
    Start = Timer
    Do While Timer < Start + PauseTime
        VBA.DoEvents
    Loop
    ActiveSheet.Shapes("Picture " & 18 + m).Top = ActiveSheet.Shapes("Image1").Top
    ActiveSheet.Shapes("Picture " & 18 + m).Left = ActiveSheet.Shapes("Image1").Left
    ActiveSheet.Shapes("Picture " & 18 + m).Width = 1
    ActiveSheet.Shapes("Picture " & 18 + m).Height = 1
    Exit Sub
End If
End If
    ActiveSheet.Shapes("Image2").IncrementTop -14
    VBA.DoEvents
    子弹
End Sub

Sub 头像()
Dim tpx%
If b = 1 Then Exit Sub
For tpx = 19 To 28
    If ActiveSheet.Shapes("Picture " & tpx).Width <> 1 Then
        ActiveSheet.Shapes("Picture " & tpx).Top = ActiveSheet.Shapes("Image1").Top
        ActiveSheet.Shapes("Picture " & tpx).Left = ActiveSheet.Shapes("Image1").Left
        ActiveSheet.Shapes("Picture " & tpx).Width = 1
        ActiveSheet.Shapes("Picture " & tpx).Height = 1
    End If
Next
If ActiveSheet.Shapes("Picture 5").Left = 0 Then
    ActiveSheet.Shapes("Picture 5").Left = 570
End If
PauseTime = 0.05
Start = Timer
    Do While Timer < Start + PauseTime
        VBA.DoEvents
    Loop
ActiveSheet.Shapes("Picture 5").IncrementLeft -14
VBA.DoEvents
头像
End Sub

Ym6vtMdG.rar (67.05 KB, 下载次数: 329)

2008-7-27 04:07 上传

点击文件名下载附件
excel做的射击游戏(射中有奖励看PP)

无密码

[此贴子已经被作者于2008-7-27 4:09:56编辑过]

wangbo_cd

没看到开始按钮啊，，，代码都不公开，晕

wangbo_cd

玩了下，，

xinhunter

有点意思。

gxuan2008

好玩。

代码不能公布么？

这里是学习交流的地方啊。

嘿嘿，

不要吊大家的胃口哦。

gs6818115

加一个情景化的背景就好了

FXSHENG

有点意思。同意6楼意见，加油啊！

cmcc1861

没意思，不好玩，好像有点问题，就能射一次，射中了也没出现什么。

wancj

谢谢，请问奖励品在何处存放？

苏粲henry

下下来，去玩玩。谢谢了哟！！！