main.frm

用vb做的乒乓球游戏源代码

VERSION 5.00
Begin VB.Form frmMain 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00008000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Ping Pong"
   ClientHeight    =   4965
   ClientLeft      =   150
   ClientTop       =   720
   ClientWidth     =   6615
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   331
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   441
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer tmrBall 
      Interval        =   50
      Left            =   3840
      Top             =   3000
   End
   Begin VB.Shape Ball 
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FFFFFF&
      FillColor       =   &H00FFFFFF&
      Height          =   375
      Left            =   3060
      Shape           =   3  'Circle
      Top             =   2400
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.Line ln 
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   3
      X1              =   216
      X2              =   216
      Y1              =   0
      Y2              =   328
   End
   Begin VB.Shape Op 
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FFFFFF&
      FillColor       =   &H00FFFFFF&
      FillStyle       =   0  'Solid
      Height          =   975
      Left            =   6240
      Top             =   1920
      Visible         =   0   'False
      Width           =   135
   End
   Begin VB.Shape You 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FFFFFF&
      FillColor       =   &H00FFFFFF&
      FillStyle       =   0  'Solid
      Height          =   975
      Left            =   120
      Top             =   1800
      Visible         =   0   'False
      Width           =   135
   End
   Begin VB.Menu mnuGame 
      Caption         =   "&Game"
      Begin VB.Menu mnuGameStart 
         Caption         =   "&New Game"
         Shortcut        =   {F2}
      End
      Begin VB.Menu mnuGamePause 
         Caption         =   "&Pause"
         Enabled         =   0   'False
         Shortcut        =   {F3}
      End
      Begin VB.Menu mnuGameSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuGameExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "&About"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mbPlay As Boolean
Dim Direction As Integer
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If mbPlay = False Then Exit Sub
If KeyCode = vbKeyUp Then You.Top = You.Top - 10
If KeyCode = vbKeyDown Then You.Top = You.Top + 10
End Sub

Private Sub Form_Load()
Direction = 1
End Sub

Private Sub Form_Resize()
ln.X1 = ScaleWidth / 2
ln.X2 = ln.X1
ln.Y1 = 0
ln.Y2 = ScaleHeight
End Sub

Private Sub mnuAbout_Click()
MsgBox "This example is brought to you by Visual Basic Monster" + vbCrLf + "http://vbmonster.cjb.net" + vbCrLf + "[e-mail]", vbOKOnly, "About"
End Sub

Private Sub mnuGameExit_Click()
Unload Me
End Sub
Private Sub mnuGamePause_Click()
mbPlay = Not mbPlay
If mnuGamePause.Caption = "&Play" Then mnuGamePause.Caption = "&Pause" Else mnuGamePause.Caption = "&Play"
End Sub
Private Sub mnuGameStart_Click()
You.Visible = True
Op.Visible = True
Ball.Visible = True
mbPlay = True
mnuGamePause.Enabled = True
End Sub

Private Sub tmrBall_Timer()
If mbPlay = False Then Exit Sub
Dim Was As Boolean
If (Ball.Left + Ball.Width) >= Op.Left Then
    If Ball.Top >= Op.Top Then
        If Ball.Top <= (Op.Top + Op.Height) Then
            If Direction = 1 Then Direction = 0
        End If
    End If
End If
If Ball.Left < (You.Left + You.Width) Then
    If Ball.Top > You.Top Then
        If Ball.Top <= (You.Top + You.Height) Then
            If Direction = 0 Then Direction = 1
        End If
    End If
End If
If Ball.Left <= 0 Then GameOver
If Ball.Left >= Me.ScaleWidth Then GameOver
If Direction = 0 Then Ball.Left = Ball.Left - 10
If Direction = 1 Then Ball.Left = Ball.Left + 10
End Sub
Sub GameOver()
MsgBox "Game Over!", vbExclamation
mbPlay = False
Ball.Left = Me.ScaleWidth / 2
You.Top = Me.ScaleHeight / 2 - You.Height / 2
Op.Top = You.Top
End Sub