[Vb.Net] XNA - Pong-VBForums
Results 1 to 1 of 1

Thread: [Vb.Net] XNA - Pong

  1. #1

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    4,781

    [Vb.Net] XNA - Pong

    Here is a player vs player version of pong written in visual basic.net using XNA. To start, simply start a new windows form application and add the XNA references, if you do not know how to add the XNA references you can see how to do so here.

    The only control I have added is a picturebox. The properties are:
    Name: pb_surface
    Dock: Fill

    I've also used JMcIlhinney's "Add a Pause to Your Code", here.

    Code:
    Option Strict On
    Option Explicit On
    
    Imports Microsoft.Xna.Framework
    Imports Microsoft.Xna.Framework.Graphics
    Public Class Form1
    
        Private grafix As GraphicsDevice
        Private effect As BasicEffect
        Private quit As Boolean = False
        Private playing As Boolean = False
        Private player1 As Paddle
        Private player2 As Paddle
        Private pong As Ball
    
        'In XNA the flow is:
        'Initialize
        'Load Content
        'Update <> Draw - Repeat the process until finished
        'Unload
    
        'Initializes the graphics device
        'This is apart of the Initialize process
        Private Function InitializeGraphics(ByRef surface As PictureBox) As Boolean
            Try
                Dim pparam As New PresentationParameters
                pparam.DeviceWindowHandle = surface.Handle
                pparam.IsFullScreen = False
    
                Dim grafixAdapt As GraphicsAdapter = GraphicsAdapter.DefaultAdapter
    
                grafix = New GraphicsDevice(grafixAdapt, GraphicsProfile.HiDef, pparam)
    
    
                InitializeGraphics = True
            Catch ex As Exception
                InitializeGraphics = False
            End Try
        End Function
    
        'Initializes the basic effect
        'This is apart of the Initialize process
        Private Function InitializeEffect(ByVal graphics As GraphicsDevice) As Boolean
            effect = New BasicEffect(graphics)
    
            Try
                effect.VertexColorEnabled = True
                effect.Projection = Matrix.CreateOrthographicOffCenter(0, graphics.Viewport.Width, graphics.Viewport.Height, 0, 0, 1)
    
                InitializeEffect = True
            Catch ex As Exception
                InitializeEffect = False
            End Try
        End Function
    
        'Managed game loop set at 60FPS or it executes the code 16.6 times per millisecond
        'This is apart of the Update process
        Private Sub GameLoop()
            grafix.Clear(Color.White)
            effect.CurrentTechnique.Passes(0).Apply()
    
            Call Draw()
            Call CheckCollision()
    
            grafix.Present()
    
            If playing = False Then
                Call NewGame()
            End If
    
            'I have MovePaddle after the conditional statement b/c
            'In the form_closing I set quit to false so that every
            'Control disposes correctly
            If quit = False AndAlso playing = True Then
                Call MovePaddle()
                Call MoveBall()
    
                ExecuteAfterPause(8, New MethodInvoker(AddressOf GameLoop))
            End If
        End Sub
    
        'This draws the two players and the ball
        'This is apart of the Draw process
        Private Sub Draw()
    
            grafix.DrawUserPrimitives(PrimitiveType.LineList, player1.Primative, 0, 1)
            grafix.DrawUserPrimitives(PrimitiveType.LineList, player2.Primative, 0, 1)
            grafix.DrawUserPrimitives(PrimitiveType.LineStrip, pong.Primative, 0, 99)
    
        End Sub
    
        'This updates the location of the paddle
        'This is apart of the Update process
        Private Sub MovePaddle()
            player1.Y_Location = PointToClient(MousePosition).Y - CInt(player1.Length / 2)
    
            player1.Primative = Set2dLine(player1.X_Location, player1.Y_Location, player1.Z_Location, player1.X_Location, player1.Y_Location + player1.Length, player1.Z_Location, player1.Color)
            player2.Primative = Set2dLine(player2.X_Location, player2.Y_Location, player2.Z_Location, player2.X_Location, player2.Y_Location + player2.Length, player2.Z_Location, player2.Color)
        End Sub
    
        'This updates the location of the ball
        'This is apart of the Update process
        Private Sub MoveBall()
            pong.X_Location += pong.X_Movement
            pong.Y_Location += pong.Y_Movement
    
            pong.Primative = Set2dEllipse(pong.X_Location, pong.Y_Location, pong.Z_Location, New Size(5, 5), player1.Color)
        End Sub
    
        Private Sub CheckCollision()
            'It hit the left-side or right-side wall
            If pong.X_Location <= 0 OrElse pong.X_Location + pong.Size.Width >= pb_surface.Width Then
                playing = False
            End If
    
            'It hit the top-side or bottom-side wall
            If pong.Y_Location <= 0 OrElse pong.Y_Location + pong.Size.Height >= pb_surface.Height Then
                pong.Y_Movement = -pong.Y_Movement
            End If
    
            'It hit player1 or player2
            Dim paddle1Rect As New Rectangle(player1.X_Location, player1.Y_Location, 1, player1.Length)
            Dim paddle2Rect As New Rectangle(player2.X_Location, player2.Y_Location, 1, player2.Length)
            Dim pongRect As New Rectangle(pong.X_Location, pong.Y_Location, pong.Size.Width, pong.Size.Height)
    
            If pongRect.Intersects(paddle1Rect) OrElse pongRect.Intersects(paddle2Rect) Then
                pong.X_Movement = -pong.X_Movement
            End If
    
        End Sub
    
        'This starts a new game
        'This is apart of the load process
        Private Sub NewGame()
            player1 = New Paddle
            player2 = New Paddle
            pong = New Ball
    
            With player1
                .Color = Color.Black
                .Length = 50
                .X_Location = 15
                .Y_Location = CInt(pb_surface.Height / 2) - CInt(.Length / 2)
                .Z_Location = 0
                .Primative = Set2dLine(.X_Location, .Y_Location, .Z_Location, .X_Location, .Y_Location + .Length, .Z_Location, .Color)
            End With
    
            With player2
                .Color = player1.Color
                .Length = player1.Length
                .X_Location = pb_surface.Width - player1.X_Location
                .Y_Location = player1.Y_Location
                .Z_Location = player1.Z_Location
                .Primative = Set2dLine(.X_Location, .Y_Location, .Z_Location, .X_Location, .Y_Location + .Length, .Z_Location, .Color)
            End With
    
            With pong
                .Color = player1.Color
                .X_Location = CInt(pb_surface.Width / 2)
                .Y_Location = CInt(pb_surface.Height / 2) - CInt(.Length / 2)
                .Z_Location = player1.Z_Location
                .X_Movement = -1
                .Y_Movement = -1
                .Size = New Size(5, 5)
                .Primative = Set2dEllipse(.X_Location, .Y_Location, .Z_Location, .Size, player1.Color)
            End With
    
        End Sub
    
        'This function simply draws a line
        Private Function Set2dLine(ByVal x1 As Integer, ByVal y1 As Integer, ByVal z1 As Integer, _
                                     ByVal x2 As Integer, ByVal y2 As Integer, ByVal z2 As Integer, _
                                     ByVal color As Color) As VertexPositionColor()
            Dim vertices1, vertices2 As New VertexPositionColor
    
            vertices1.Position = New Vector3(x1, y1, z1)
            vertices1.Color = color
            vertices2.Position = New Vector3(x2, y2, z2)
            vertices2.Color = color
    
            Return {vertices1, vertices2}
        End Function
    
        'This function simply draws an ellipse
        Private Function Set2dEllipse(ByVal x As Integer, ByVal y As Integer, ByVal z As Integer, _
                                      ByVal size As Size, ByVal color As Color) As VertexPositionColor()
    
            Dim vertices(100) As VertexPositionColor
    
            For i As Integer = 0 To 100
                Dim angle As Double = CDbl(i / 100 * Math.PI * 2)
                vertices(i).Position = New Vector3(CSng(x + CDbl(Math.Cos(angle)) * size.Width), CSng(y + Math.Sin(angle) * size.Height), z)
                vertices(i).Color = color
            Next
    
            Return vertices
        End Function
    
        Private Sub pb_Surface_Click(sender As Object, e As System.EventArgs) Handles pb_surface.Click
            If playing = False Then
                playing = True
    
                Call NewGame()
                Call GameLoop()
            End If
        End Sub
    
        Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
            quit = True
        End Sub
    
        Private Sub Form1_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
            If playing = True AndAlso e.KeyCode = Keys.Down Then
                player2.Y_Location += 5
            ElseIf playing = True AndAlso e.KeyCode = Keys.Up Then
                player2.Y_Location -= 5
            End If
        End Sub
    
        Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
            With Me
                .KeyPreview = True
                .Size = New Size(600, 300)
                .StartPosition = FormStartPosition.CenterScreen
                .Text = "XNA Pong"
            End With
    
            If InitializeGraphics(pb_surface) AndAlso InitializeEffect(grafix) Then
                MessageBox.Show("Player1 controls the paddle with the mouse." & Environment.NewLine & _
                                "Player2 controls the paddle with the up/down keys." & Environment.NewLine & _
                                "Click the mouse to start!", Me.Text, MessageBoxButtons.OK)
            Else
                MessageBox.Show("Error initializing the graphics.")
            End If
        End Sub
    
    End Class
    
    Public Class Paddle
    
        Private x As Integer
        Public Property X_Location() As Integer
            Get
                Return x
            End Get
            Set(ByVal value As Integer)
                x = value
            End Set
        End Property
    
        Private y As Integer
        Public Property Y_Location() As Integer
            Get
                Return y
            End Get
            Set(ByVal value As Integer)
                y = value
            End Set
        End Property
    
        Private z As Integer
        Public Property Z_Location() As Integer
            Get
                Return z
            End Get
            Set(ByVal value As Integer)
                z = value
            End Set
        End Property
    
        Private _len As Integer
        Public Property Length() As Integer
            Get
                Return _len
            End Get
            Set(ByVal value As Integer)
                _len = value
            End Set
        End Property
    
        Private _color As Color
        Public Property Color() As Color
            Get
                Return _color
            End Get
            Set(ByVal value As Color)
                _color = value
            End Set
        End Property
    
        Public Property Primative As VertexPositionColor()
    
    End Class
    
    Public Class Ball
        Inherits Paddle
    
        Private x_move As Integer
        Public Property X_Movement() As Integer
            Get
                Return x_move
            End Get
            Set(ByVal value As Integer)
                x_move = value
            End Set
        End Property
    
        Private y_move As Integer
        Public Property Y_Movement() As Integer
            Get
                Return y_move
            End Get
            Set(ByVal value As Integer)
                y_move = value
            End Set
        End Property
    
        Private _size As Size
        Public Property Size() As Size
            Get
                Return _size
            End Get
            Set(ByVal value As Size)
                _size = value
            End Set
        End Property
    
    End Class
    I hope that you enjoy.
    Last edited by dday9; Oct 11th, 2013 at 10:15 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.