www.pudn.com > On_Screen_Ping_Pong.zip > Form1.frm
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Ping Pong!"
ClientHeight = 1410
ClientLeft = 45
ClientTop = 330
ClientWidth = 2295
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1410
ScaleWidth = 2295
Begin VB.Timer timerBall
Enabled = 0 'False
Interval = 50
Left = 30
Top = 60
End
Begin VB.CommandButton cmdGo
Caption = "Go"
Height = 375
Left = 690
TabIndex = 2
Top = 750
Width = 990
End
Begin VB.CommandButton cmdKbrdTest
Caption = "cmdKbrdTest"
Height = 390
Left = 1995
TabIndex = 1
Top = 1140
Visible = 0 'False
Width = 1740
End
Begin VB.Timer timerKbrd
Enabled = 0 'False
Interval = 100
Left = 1845
Top = 30
End
Begin VB.Label lblURL
Alignment = 2 'Center
BackColor = &H0000FFFF&
Caption = "Home Page"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 225
Left = 120
MouseIcon = "Form1.frx":014A
MousePointer = 99 'Custom
TabIndex = 5
Top = 1155
Width = 2055
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "['],[/]"
Height = 195
Left = 1890
TabIndex = 4
Top = 765
Width = 330
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "[A],[Z]"
Height = 195
Left = 75
TabIndex = 3
Top = 765
Width = 435
End
Begin VB.Label lblScore
Alignment = 2 'Center
Caption = "0:0"
BeginProperty Font
Name = "Arial"
Size = 24
Charset = 177
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 90
TabIndex = 0
Top = 60
Width = 2130
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' =======================================
' On-Screen Ping Pong
' =======================================
'
' This is an two player ping-pong. Play
' ping pong among all other windows
' on your system. Use [A]-[Z] to control
' left player's bar, and [']-[/] to control
' right player's bar.
'
' Visit my Homepage:
' http://www.geocities.com/emu8086/vb/
'
'
' Last Update: Saturday, July 20, 2002
'
'
' Copyright 2002 Alexander Popov Emulation Soft.
' All rights reserved.
' http://www.geocities.com/emu8086/
Option Explicit
Dim arrKBRD(256) As Byte
Dim scoreLEFT As Single
Dim scoreRIGHT As Single
Dim ballStepX As Integer
Dim ballStepY As Integer
Private Sub updateScore(dLEFT As Integer, dRIGHT As Integer)
scoreLEFT = scoreLEFT + dLEFT
scoreRIGHT = scoreRIGHT + dRIGHT
lblScore.Caption = scoreLEFT & " : " & scoreRIGHT
End Sub
Private Sub makeBall()
Dim lngRegion As Long
'Create the Region
lngRegion = CreateEllipticRgn(0, 0, frmBall.Width / Screen.TwipsPerPixelX, frmBall.Height / Screen.TwipsPerPixelY)
'Clip it!
Call SetWindowRgn(frmBall.hwnd, lngRegion, True)
End Sub
Private Sub showBars()
frmRight.Show ' center screen (default)!
frmRight.Left = Screen.Width - frmRight.Width
frmLeft.Show ' center screen (default)!
frmLeft.Left = 0
End Sub
Private Sub cmdGo_Click()
makeBall
showBars
scoreLEFT = 0
scoreRIGHT = 0
updateScore 0, 0
Randomize
resetBALL
timerBall.Enabled = True
timerKbrd.Enabled = True
End Sub
Private Sub resetBALL()
frmBall.Show
If getRand(0, 1) = 0 Then
ballStepX = 400
Else
ballStepX = -400
End If
ballStepY = getRand(-300, 300)
End Sub
Private Function getRand(LOWERBOUND As Integer, UPPERBOUND As Integer) As Integer
getRand = Int((UPPERBOUND - LOWERBOUND + 1) * Rnd + LOWERBOUND)
End Function
Private Sub cmdKbrdTest_Click()
Dim i As Integer
GetKeyboardState arrKBRD(0)
For i = 0 To 255
If (arrKBRD(i) <> 0) And (arrKBRD(i) <> 1) Then
Debug.Print i & " - " & arrKBRD(i)
End If
Next i
End Sub
Private Sub Form_Load()
Me.Left = Screen.Width / 2 - Me.Width / 2
End Sub
Private Sub Form_Unload(Cancel As Integer)
End ' close all windows!
End Sub
Private Sub lblURL_Click()
Call ShellExecute(Me.hwnd, "open", "http://www.geocities.com/emu8086/vb/", "", App.Path, SW_SHOWDEFAULT)
End Sub
Private Sub timerBall_Timer()
frmBall.Left = frmBall.Left + ballStepX
frmBall.Top = frmBall.Top + ballStepY
checkBALL
End Sub
Private Sub checkBALL()
''' collision with screen borders:
If frmBall.Top <= 0 Then
ballStepY = makePLUS(ballStepY)
frmBall.Top = 1
End If
If (frmBall.Top + frmBall.Height) >= Screen.Height Then
ballStepY = makeMINUS(ballStepY)
frmBall.Top = Screen.Height - 1 - frmBall.Height
End If
If frmBall.Left <= 0 Then
ballStepX = makePLUS(ballStepX)
frmBall.Left = 1
updateScore 0, 1
End If
If (frmBall.Left + frmBall.Width) >= Screen.Width Then
ballStepX = makeMINUS(ballStepX)
frmBall.Left = Screen.Width - 1 - frmBall.Width
updateScore 1, 0
End If
'''''''''''' collision with bars:
If ((frmBall.Left + frmBall.Width) >= frmRight.Left) And _
(frmBall.Top + frmBall.Height) >= frmRight.Top And _
(frmBall.Top < (frmRight.Top + frmRight.Height)) Then
ballStepX = makeMINUS(ballStepX)
frmBall.Left = frmRight.Left - frmBall.Width - 1
ballStepY = getRand(-200, 200)
End If
If (frmBall.Left <= (frmLeft.Left + frmLeft.Width)) And _
(frmBall.Top + frmBall.Height) >= frmLeft.Top And _
(frmBall.Top < (frmLeft.Top + frmLeft.Height)) Then
ballStepX = makePLUS(ballStepX)
frmBall.Left = frmLeft.Left + frmBall.Width + 1
ballStepY = getRand(-200, 200)
End If
End Sub
Private Sub timerKbrd_Timer()
Const MOVE_STEP = 350
GetKeyboardState arrKBRD(0)
If (arrKBRD(222) > 1) Then ' " - key
frmRight.Top = frmRight.Top - MOVE_STEP
ElseIf (arrKBRD(191) > 1) Then ' / - key
frmRight.Top = frmRight.Top + MOVE_STEP
End If
If (arrKBRD(65) > 1) Then ' A - key
frmLeft.Top = frmLeft.Top - MOVE_STEP
ElseIf (arrKBRD(90) > 1) Then ' Z - key
frmLeft.Top = frmLeft.Top + MOVE_STEP
End If
If (arrKBRD(27) > 1) Then End ' ESC
End Sub
Private Function makeMINUS(i As Integer) As Integer
If i > 0 Then
makeMINUS = -i
Else
makeMINUS = i
End If
End Function
Private Function makePLUS(i As Integer) As Integer
If i > 0 Then
makePLUS = i
Else
makePLUS = -i
End If
End Function