VB6 - CPP: Pong [source]

[Fox]

Erm... well *g* Open a new project, add the following code and run.
Remember to delete the default "Form_Load" sub before copying.
There's 2 postings because it was too long for one.

'Copy-Pong by [email][email protected][/email]
'Written on 2003-04-21
'Visit [url]http://vbfx.yhoko.com/[/url]
 
'Types
    Private Type tKeyTable
        KeyUp As Long
        KeyDown As Long
    End Type
    
    Private Type tCamera
        'Size
        w As Long
        h As Long
        
        'General
        DC As Long
    End Type
    
    Private Type tObject
        'Size
        x As Single
        y As Single
        
        'Start position
        w As Long
        h As Long
        
        'Movement
        SpeedX As Single
        SpeedY As Single
        
        'General
        IsBall As Boolean
        Color As Long
    End Type
    
    Private Type tPlayer
        'General
        Name As String
        Score As Long
        
        'Internal
        KeyTable As tKeyTable
        Pad As tObject
    End Type
 
'Declares
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    Private Declare Function Rectangle Lib "gdi32" (ByVal iDC As Long, _
        ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
 
'Variables
    'Internal
    Dim Active As Boolean
    Dim MaxFPS As Long
    Dim KD() As Boolean
    
    Dim Camera As tCamera
    
    'Game objects
    Dim PlayerCount As Long
    Dim Player() As tPlayer
    
    Dim BallCount As Long
    Dim Ball() As tObject
    
    Dim PadSpeed As Long
    Dim PadAcceleration As Single
    
    Dim BallSpeed As Long
    Dim BallAcceleration As Single
    
    Dim Friction As Single
    
Private Sub CheckKeys()
    Dim A As Long
    
    If KD(vbKeyEscape) Then: Unload Me
    
    For A = 0 To PlayerCount
        With Player(A)
            If KD(.KeyTable.KeyUp) Then
                'Key press up
                .Pad.SpeedY = .Pad.SpeedY - PadAcceleration
                If .Pad.SpeedY < -PadSpeed Then: .Pad.SpeedY = -PadSpeed
            End If
            
            If KD(.KeyTable.KeyDown) Then
                'Key press down
                .Pad.SpeedY = .Pad.SpeedY + PadAcceleration
                If .Pad.SpeedY > PadSpeed Then: .Pad.SpeedY = PadSpeed
            End If
            
            If Not (KD(.KeyTable.KeyUp) Or KD(.KeyTable.KeyDown)) Then
                'No keys
                .Pad.SpeedY = .Pad.SpeedY * Friction
                If Abs(.Pad.SpeedY) < Friction Then: .Pad.SpeedY = 0
            End If
        End With
    Next
End Sub
 
Private Sub DrawObject(iObject As tObject)
    Dim Temp As tKeyTable
    
    'Draw object rect
    With iObject
        Me.FillColor = .Color
        Me.ForeColor = .Color
        
        If .IsBall Then
            Me.Circle (CLng(.x), CLng(.y)), .w
        Else
            Rectangle Camera.DC, CLng(.x), CLng(.y), CLng(.x + .w), CLng(.y + .h)
        End If
    End With
End Sub
 
Private Sub DrawScore()
    Dim A As Long
    
    For A = 0 To PlayerCount
        With Me
            'Text position
            .CurrentX = Player(A).Pad.x
            .CurrentY = 20
            
            'Print text
            .ForeColor = RGB(255, 0, 0)
            Me.Print CStr(Player(A).Score)
        End With
    Next
End Sub
 
Private Sub GameOver(iWinner As Long)
    Dim A As Long
    
    'Beeps
    For A = 0 To 4: Beep: Next
    
    Player(iWinner).Score = Player(iWinner).Score + 1
    
    'Play again?
    If MsgBox(Player(iWinner).Name & " wins!" & vbNewLine & vbNewLine & _
        "Play again?", vbInformation Or vbYesNo, "Game Over") = vbNo Then: Unload Me
End Sub
 
Private Sub InitBall(iObject As tObject)
    With iObject
        'Start position
        .x = (Camera.w - .w) / 2
        .y = (Camera.h - .h) / 2
        
        'Initial speed
        .SpeedX = IIf(100 * Rnd > 50, BallSpeed, -BallSpeed)
        .SpeedY = ((2 * Rnd) - 1) * BallSpeed
    End With
    
    'Release pressed keys
     ReDim KD(255)
End Sub
 
Sub Main()
    Dim Temp As Long
    
    While Active
        If Temp < GetTickCount Then
            'Timing
            Temp = GetTickCount + (1000 / MaxFPS)
            
            'Interface
            CheckKeys
            MoveObjects
            
            If Active Then
                'Get context
                Me.Cls
                Camera.DC = Me.hdc
                
                'Update window
                DrawObjects
                DrawScore
                
                Me.Refresh
            End If
        End If
        
        DoEvents
    Wend
End Sub