I am trying to recreate Copter in visual basic, so far I have the player, roof and helicopter but I can't seem to get the game to end when the player touches the floor or roof. Sorry for posting so much, this is my first time on here and I didn't know what to paste. Any help is appreciated :D
Public Class Form1
Dim pb_field As PictureBox
Private Sub create_field()
pb_field = New PictureBox
With pb_field
.Top = 20
.Left = 20
.Width = 500
.Height = 300
.BackColor = Color.Black
End With
Me.Controls.Add(pb_field)
pb_field.BringToFront()
End Sub
Dim pb_player As PictureBox
Private Sub create_player()
pb_player = New PictureBox
With pb_player
.Width = 20
.Height = 20
.BackColor = Color.Red
.Top = pb_field.Top + pb_field.Bottom / 2
.Left = pb_field.Left + 20
End With
Me.Controls.Add(pb_player)
pb_player.BringToFront()
End Sub
#Region "Roof Stuff"
Dim roof(10000) As PictureBox
Dim num_of_roof As Integer = -1
Dim r As New Random
Private Sub create_roof()
num_of_roof += 1
roof(num_of_roof) = New PictureBox
With roof(num_of_roof)
.Top = pb_field.Top
.Left = pb_field.Right
.Height = r.Next(20, 40)
.Width = 20
.BackColor = Color.RoyalBlue
End With
Me.Controls.Add(roof(num_of_roof))
roof(num_of_roof).BringToFront()
End Sub
#End Region
#Region "floor Stuff"
Dim floor(10000) As PictureBox
Dim num_of_floor As Integer = -1
Private Sub create_floor()
num_of_floor += 1
floor(num_of_floor) = New PictureBox
With floor(num_of_floor)
.Left = pb_field.Right
.Height = r.Next(20, 40)
.Width = 20
.Top = pb_field.Bottom - floor(num_of_floor).Height
.BackColor = Color.YellowGreen
End With
Me.Controls.Add(floor(num_of_floor))
floor(num_of_floor).BringToFront()
End Sub
#End Region
Private Sub Form1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Me.KeyPress
Me.Text = e.KeyChar
If e.KeyChar = "w" Then
pb_player.Top -= 10
End If
**Dim collision As Boolean
For Each PictureBox In Me.Controls
If pb_player.Bounds.IntersectsWith(roof(num_of_roof).Bounds) Then
collision = True
Exit For
Else : collision = False
End If
If collision = True Then
MessageBox.Show("Unlucky,better luck next time!")
End If**
Next
End Sub
Private Sub form1_load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
create_field()
create_roof()
create_player()
tm_background.Start()
tm_gravity.Start()
End Sub
Private Sub tm_background_Tick(sender As Object, e As EventArgs) Handles tm_background.Tick
For i = 0 To num_of_roof
roof(i).Left -= 20
If roof(i).Left < pb_field.Left Then
Me.Controls.Remove(roof(i))
End If
Next
create_roof()
For i = 0 To num_of_floor
floor(i).Left -= 20
If floor(i).Left < pb_field.Left Then
Me.Controls.Remove(floor(i))
End If
Next
create_floor()
End Sub
Private Sub tm_gravity_Tick(sender As Object, e As EventArgs) Handles tm_gravity.Tick
pb_player.Top += 5
End Sub
This is the code I was attempting to use after looking online at possible solutions
Private Sub Form1_KeyPress(sender As Object, e As KeyPressEventArgs) HandlesMe.KeyPress
Me.Text = e.KeyChar
If e.KeyChar = "w" Then
pb_player.Top -= 10
End If
Dim collision As Boolean
For Each PictureBox In Me.Controls
If pb_player.Bounds.IntersectsWith(roof(num_of_roof).Bounds) Then
collision = True
Exit For
Else : collision = False
End If
If collision = True Then
MessageBox.Show("Unlucky,better luck next time!")
End If
Next
End Sub
Your problem is where you exit the for loop before displaying the message:
For Each PictureBox In Me.Controls
If pb_player.Bounds.IntersectsWith(roof(num_of_roof).Bounds) Then
collision = True
Exit For ' Note that exiting skips your check after the End If below
Else : collision = False
End If
' Whenever this is true you have already exited your 'for' loop
If collision = True Then
MessageBox.Show("Unlucky,better luck next time!")
End If
Next
Instead you need something like this where you evaluate the condition after the loop:
For Each PictureBox In Me.Controls
If pb_player.Bounds.IntersectsWith(roof(num_of_roof).Bounds) Then
collision = True
Exit For
Else : collision = False
End If
Next
If collision = True Then
MessageBox.Show("Unlucky,better luck next time!")
End If
First you need to set tag's in the floor and ceiling regions
With floor(num_of_floor)
.Tag = "boundaries"
Then you can refer to each picturebox in your controls
For Each box As PictureBox In Me.Controls
If box.Tag <> "boundaries" Then Continue For
If pb_player.Bounds.IntersectsWith(box.Bounds) Then
collision = True
Exit For
Else : collision = False
End If
Next
However, you are still going to have a problem that when it hits the floor it will not pass as a collision, because all this code is going on in the key press,
If a user lets the coptor fall, it will only lose the next time they click on the keyboard
Related
For some reason when I added the start button and combobox to try and create profiles the program unfocuses the game inside the picture box and i am unable to press (w,a,s,d) to play it.
If i remove the button and combobox the game works fine. So i think it is some sort of focus issue i just dont know how to fix it, here is my code:
Imports System.IO
Public Class Form1
#Region "snake"
Dim snake(999) As PictureBox
Dim lengthSnake As Integer = -1
Dim leftRightMover As Integer = 0
Dim upDownMover As Integer = 0
Dim random As New Random
Sub createHead()
lengthSnake += 1
snake(lengthSnake) = New PictureBox
With snake(lengthSnake)
.Height = 15
.Width = 15
.BackColor = Color.LimeGreen
.Top = (picPlayingArea.Top + picPlayingArea.Bottom) / 2
.Left = (picPlayingArea.Left + picPlayingArea.Right) / 2
End With
Controls.Add(snake(lengthSnake))
snake(lengthSnake).BringToFront()
snakegrow()
snakegrow()
End Sub
Private Sub Form1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Me.KeyPress
tmrSnakeMove.Start()
Select Case e.KeyChar
Case "a"
leftRightMover = -15
upDownMover = 0
Case "d"
leftRightMover = 15
upDownMover = 0
Case "w"
upDownMover = -15
leftRightMover = 0
Case "s"
upDownMover = 15
leftRightMover = 0
End Select
End Sub
Private Sub tmrSnakeMove_Tick(sender As Object, e As EventArgs) Handles tmrSnakeMove.Tick
For i = lengthSnake To 1 Step -1
snake(i).Top = snake(i - 1).Top
snake(i).Left = snake(i - 1).Left
Next
snake(0).Top += upDownMover
snake(0).Left += leftRightMover
collideWalls()
collideApple()
collideSnake()
End Sub
Sub snakegrow()
lengthSnake += 1
snake(lengthSnake) = New PictureBox
With snake(lengthSnake)
.Height = 15
.Width = 15
.BackColor = Color.Green
.Top = snake(lengthSnake - 1).Top
.Left = snake(lengthSnake - 1).Left + 10
End With
Controls.Add(snake(lengthSnake))
snake(lengthSnake).BringToFront()
End Sub
Sub snakedied()
If Val(lblApple.Text) > Val(lblTrophy.Text) Then
Dim FS As New FileStream("highscore.txt", FileMode.Create, FileAccess.Write)
Dim SW As New StreamWriter(FS)
SW.WriteLine(Score)
SW.Close()
FS.Close()
End If
End Sub
#End Region
#Region "Collision"
Sub collideWalls()
If snake(0).Left < picPlayingArea.Left Then
tmrSnakeMove.Stop()
MsgBox("Game Over")
snakedied()
Me.Close()
ElseIf snake(0).Right > picPlayingArea.Right Then
tmrSnakeMove.Stop()
MsgBox("Game Over")
snakedied()
Me.Close()
ElseIf snake(0).Top < picPlayingArea.Top Then
tmrSnakeMove.Stop()
MsgBox("Game Over")
snakedied()
Me.Close()
ElseIf snake(0).Bottom > picPlayingArea.Bottom Then
tmrSnakeMove.Stop()
MsgBox("Game Over")
snakedied()
Me.Close()
End If
End Sub
Dim Score As Integer
Sub collideApple()
If snake(0).Bounds.IntersectsWith(apple.Bounds) Then
Score = Score + 1
snakegrow()
apple.Top = random.Next(picPlayingArea.Top, picPlayingArea.Bottom - 10)
apple.Left = random.Next(picPlayingArea.Left, picPlayingArea.Right - 10)
lblApple.Text = Score
End If
End Sub
Sub collideSnake()
For i = 1 To lengthSnake
If snake(0).Bounds.IntersectsWith(snake(i).Bounds) Then
tmrSnakeMove.Stop()
MsgBox("Game Over")
snakedied()
Me.Close()
End If
Next
End Sub
#End Region
#Region "Apples"
Dim apple As PictureBox
Sub createApple()
apple = New PictureBox
With apple
.Width = 15
.Height = 15
.BackColor = Color.Red
.Top = random.Next(picPlayingArea.Top, picPlayingArea.Bottom - 10)
.Left = random.Next(picPlayingArea.Left, picPlayingArea.Right - 10)
End With
Controls.Add(apple)
apple.BringToFront()
End Sub
#End Region
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
lblTrophy.Text = IO.File.ReadAllText("highscore.txt")
picApple.Image = My.Resources.apple_icon
picTrophy.Image = My.Resources.trophy
End Sub
Private Sub btnStart_Click(sender As Object, e As EventArgs) Handles btnStart.Click
If cmbChoice.Text <> Nothing Then
btnStart.Visible = False
cmbChoice.Enabled = False
createHead()
createApple()
Else
MsgBox("Choose a player.")
End If
End Sub
End Class
I am writing a piece of code that when a button is pressed, it creates a picture box, but when you hold down the same key, that picture box needs to grow.
At first my code repeated the creation of the box, but now I have tried the code below and instead it creates it once, but at the end of the code. Does anyone know how some code to execute part of a key down code on the first instance that it is held down, and only once?
Private Class Form1
Dim KeyHolding As Boolean = False
Private Sub Btn_1_KeyDown(sender As Object, e As KeyEventArgs) Handles Btn_1.KeyDown
If Not KeyHolding Then 'the events which are activated once only when the key is pressed
KeyHolding = True
Dim PB As New PictureBox With {.Width = Btn_1.Width - 2, .Height = 10, .Top = Btn_1.Top + 20, .Left = Btn_1.Left + 1, .BackColor = Color.Cyan}
PB.Name = "PB_1"
TestPanel.Controls.Add(PB)
Else 'the events which are constantly done when the key is held
End If
End Sub
Private Sub Btn_1_KeyUp(sender As Object, e As KeyEventArgs) Handles Btn_1.KeyUp
Btn_1.BackColor = SystemColors.Control
KeyHolding = False
End Sub
Try this
Dim KeyHolding As Boolean = False
Dim PB As PictureBox
Private Sub Btn_1_KeyDown(sender As Object, e As KeyEventArgs) Handles Btn_1.KeyDown
If Not KeyHolding Then 'the events which are activated once only when the key is pressed
KeyHolding = True
PB = New PictureBox With {.Width = Btn_1.Width - 2, .Height = 10, .Top = Btn_1.Top + 20, .Left = Btn_1.Left + 1, .BackColor = Color.Cyan}
PB.Name = "PB_1"
TestPanel.Controls.Add(PB)
Else 'the events which are constantly done when the key is held
PB.Width += 10
PB.Height += 10
End If
End Sub
Private Sub Btn_1_KeyUp(sender As Object, e As KeyEventArgs) Handles Btn_1.KeyUp
Btn_1.BackColor = SystemColors.Control
End Sub
I am making a two dimensional game where the user is able to shoot enemies and gain points. So far I have added borders to the level as well as the collision detection between the Player and said borders. When the player presses "w" the user shoots a bullet. Without me setting the boundaries, the bullet appears at the centre of the players sprite. With the boundaries set, the bullets appear to increase height from the player when spawned; when the player moves to the left of the screen. Vice Versa when the player moves to the right.
The first Class:
Public Class Bullet
Inherits PictureBox 'this class is a variation of a picture box
Public Sub New() 'every time bullet is accessed it will access this sub as well
With Me 'refers back to anything in the class
.Height = 5
.Width = 2
.Location = PlayScreen.PlayerShip.Location 'sets the bullets start point to the ship
.BackColor = Color.White
.SetBounds(x:=PlayScreen.PlayerShip.Left, y:=PlayScreen.PlayerShip.Left, height:=5, width:=2)
End With
End Sub
Public Sub ShootUp()
Me.Top -= 10 'Males the bullet move upwards
End Sub
End Class
The Rest of my Code:
Public Class PlayScreen
Public Shared PlayerShip As New PictureBox 'defines the ship as a picture box
Dim WallNorth As New PictureBox
Dim WallSouth As New PictureBox
Dim WallEast As New PictureBox 'these will be given collision detection to check if the player is trying to exit the boundires of the level
Dim WallWest As New PictureBox
Dim Bullets(-1) As Bullet 'makes the array have nothing in it
Dim BulletCounter As Integer 'used to make new bullets
Dim MoveRight As Boolean = False
Dim MoveLeft As Boolean = False 'Making movement based upon boolean factors allows for more user friendly controls
Dim MoveUp As Boolean = False
Dim MoveDown As Boolean = False
Dim PUHealth As New PictureBox
Dim Health As Integer
Dim Score As Integer
Private Sub PlayScreen_Load(sender As Object, e As EventArgs) Handles MyBase.Load
MovementTimer.Start()
PUHealthTimer.Start()
Health = 3
HealthLbl.Text = "Health: " & Health
Score = 0
ScoreLbl.Text = "Score: " & Score
Me.Controls.Add(PUHealth)
PUHealth.Width = 25
PUHealth.Height = 25
PUHealth.BorderStyle = BorderStyle.FixedSingle
PUHealth.BackColor = Color.Yellow
PUHealth.Top = Me.Height / 2 - 100
PUHealth.Left = Me.Width / 2 - 100
PUHealth.SetBounds(x:=Me.Height / 2 - 100, y:=Me.Width / 2 - 100, height:=25, width:=25)
Me.Controls.Add(PlayerShip) 'imports the picture box onto the PlayScreen
PlayerShip.Width = 40
PlayerShip.Height = 40 'Dimensions of the player ship
PlayerShip.BorderStyle = BorderStyle.FixedSingle 'adds a border to the picturebox
PlayerShip.BackColor = Color.White 'adds colour to the ship background
PlayerShip.SetBounds(x:=Me.Left, y:=Me.Top, height:=40, width:=40)
Me.Controls.Add(WallNorth)
WallNorth.Width = 750
WallNorth.Height = 5
WallNorth.BorderStyle = BorderStyle.FixedSingle 'this is defining the wall at the top of the screen, setting its positions as well as its bounds
WallNorth.BackColor = Color.Green
WallNorth.Top = 1
WallNorth.Left = 1
WallNorth.SetBounds(x:=1, y:=1, height:=5, width:=750)
Me.Controls.Add(WallEast)
WallEast.Width = 5
WallEast.Height = 750
WallEast.BorderStyle = BorderStyle.FixedSingle 'This defines the wall at the right of the screen, setting its position as well as its bounds
WallEast.BackColor = Color.Green
WallEast.Top = 1
WallEast.Left = 545
WallEast.SetBounds(x:=545, y:=1, width:=5, height:=750)
Me.Controls.Add(WallSouth)
WallSouth.Width = 750
WallSouth.Height = 5
WallSouth.BorderStyle = BorderStyle.FixedSingle
WallSouth.BackColor = Color.Green
WallSouth.Top = 574
WallSouth.Left = 1
WallSouth.SetBounds(x:=1, y:=573, width:=750, height:=5)
Me.Controls.Add(WallWest)
WallWest.Width = 5
WallWest.Height = 750
WallWest.BorderStyle = BorderStyle.FixedSingle
WallWest.BackColor = Color.Green
WallWest.Top = 1
WallWest.Left = 1
End Sub
Private Sub PlayScreen_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
Select Case e.KeyValue
Case Keys.Right
MoveRight = True
Case Keys.Left
MoveLeft = True 'This edits the boolean value of the varibales when the correct key is pressed
Case Keys.Up
MoveUp = True
Case Keys.Down
MoveDown = True
Case Keys.W
ReDim Preserve Bullets(BulletCounter) 'allows the array to expand more efficiently
Dim Bullet1 As New Bullet 'creates new bullet
Controls.Add(Bullet1) 'adds bullet to the screen
Bullets(BulletCounter) = Bullet1 'the new space created in the array is saved as the new bullet made
BulletCounter += 1
ShootUpTimer.Start() 'starts the shoot timer
End Select
While WallNorth.Bounds.IntersectsWith(PlayerShip.Bounds)
PlayerShip.Top += 5
End While
While WallEast.Bounds.IntersectsWith(PlayerShip.Bounds) 'I have to check if the player has collided with the wall when the key is down
PlayerShip.Left -= 5
End While
While WallSouth.Bounds.IntersectsWith(PlayerShip.Bounds)
PlayerShip.Top -= 5
End While
While WallWest.Bounds.IntersectsWith(PlayerShip.Bounds)
PlayerShip.Left += 5
End While
If PUHealth.Bounds.IntersectsWith(PlayerShip.Bounds) Then 'checks if the player has collided with the the power up
If PUHealth.Visible() Then 'This stops a bug where the player could go to the spot where the power up use to be and collect health
Health += 1 'increaeses the players health by one
HealthLbl.Text = "Health: " & Health 'displays the new player health
PUHealth.Hide() 'hides the power up
End If
End If
End Sub
Private Sub PlayScreen_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp
Select Case e.KeyValue
Case Keys.Right
MoveRight = False
Case Keys.Left
MoveLeft = False 'This edits the boolean value when the key has been lifted
Case Keys.Up
MoveUp = False
Case Keys.Down
MoveDown = False
End Select
While WallNorth.Bounds.IntersectsWith(PlayerShip.Bounds)
PlayerShip.Top += 5
End While
While WallEast.Bounds.IntersectsWith(PlayerShip.Bounds) 'i have to check if the player collides with a wall while the key is down
PlayerShip.Left -= 5
End While
While WallSouth.Bounds.IntersectsWith(PlayerShip.Bounds)
PlayerShip.Top -= 5
End While
If PUHealth.Bounds.IntersectsWith(PlayerShip.Bounds) Then
If PUHealth.Visible() Then
Health += 1
HealthLbl.Text = "Health: " & Health
PUHealth.Hide()
End If
End If
End Sub
Private Sub MovementTimer_Tick(sender As Object, e As EventArgs) Handles MovementTimer.Tick
If MoveRight = True Then
PlayerShip.Left += 5
End If
If MoveLeft = True Then
PlayerShip.Left -= 5
End If
If MoveUp = True Then
PlayerShip.Top -= 5 ' I use a timer to tick every 10 milliseconds ato check the states of each key, this statement controlls the execution of the direction
End If
If MoveDown = True Then
PlayerShip.Top += 5
End If
While WallNorth.Bounds.IntersectsWith(PlayerShip.Bounds)
PlayerShip.Top += 5
End While
While WallEast.Bounds.IntersectsWith(PlayerShip.Bounds) 'i check if the player is collided with the wall whilst the timer ticks because the player could not collide with the wall every 20 milliseconds
PlayerShip.Left -= 5
End While
While WallSouth.Bounds.IntersectsWith(PlayerShip.Bounds)
PlayerShip.Top -= 5
End While
While WallWest.Bounds.IntersectsWith(PlayerShip.Bounds)
PlayerShip.Left += 5
End While
If PUHealth.Bounds.IntersectsWith(PlayerShip.Bounds) Then
If PUHealth.Visible() Then
Health += 1
HealthLbl.Text = "Health: " & Health
PUHealth.Hide()
End If
End If
End Sub
Private Sub PUHealthTimer_Tick(sender As Object, e As EventArgs) Handles PUHealthTimer.Tick
If PUHealth.Visible() Then 'checks if the health power up i visible
Else 'if not the coordinates are randomised and then displayerd
PUHealth.Top = ((500 * Rnd()) + 10)
PUHealth.Left = ((500 * Rnd()) + 10)
PUHealth.Show()
End If
End Sub
Private Sub ShootTimerUp_Tick(sender As Object, e As EventArgs) Handles ShootUpTimer.Tick
For x = 0 To Bullets.Length - 1 'to check every position within the array apart from the newest
Bullets(x).ShootUp()
Next
End Sub
End Class
What do i need to change to get the bullets to shoot from the middle, of the top, of the ship.
In the Public Class I declared the X and Y location both as the x location
I need to create a poker game in vb as work for my class using mod13 for each suite to evaluate the winning hand... but I am at lost here. I just can't get how to use modulo.
I really need an hint how to do it. (this is what I have coded so far....)
Public Class Form1
Dim Cards(4) As PictureBox
Dim Hand(4) As Integer
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Creat_poker()
End Sub
Private Sub Creat_Poker_interface()
Dim i As Integer
For i = 0 To pic.GetUpperBound(0)
Cards(i) = New PictureBox
With Cards(i)
.Visible = True
.Width = 130
.Height = 200
.Left = 20 + (i * 160)
.Top = 20
.BorderStyle = BorderStyle.Fixed3D
.SizeMode = PictureBoxSizeMode.StretchImage
End With
Me.Controls.Add(pic(i))
AddHandler Cards(i).Click, AddressOf CardsSelection
Next
End Sub
Private Sub cmdNewGame_Click(sender As Object, e As EventArgs) Handles cmdNewGame.Click
Dim i As Integer
Dim hasard As New Random
For i = 0 To main.GetUpperBound(0)
Hand(i) = hasard.Next(52)
Next
For i = 0 To main.GetUpperBound(0)
Cards(i).Image = imaCards.Images(Hand(i))
Next
End Sub
End Class
Imports System.Threading.Thread
Public Class Form1
Dim delay As Integer = 200
Dim i As Integer = 1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
While i <= 5
PictureBox1.Visible = True
PictureBox1.Refresh()
Sleep(delay)
PictureBox1.Visible = False
PictureBox2.Visible = True
PictureBox2.Refresh()
Sleep(delay)
PictureBox2.Visible = False
PictureBox3.Visible = True
PictureBox3.Refresh()
Sleep(delay)
PictureBox3.Visible = False
PictureBox4.Visible = True
PictureBox4.Refresh()
Sleep(delay)
PictureBox4.Visible = False
PictureBox5.Visible = True
PictureBox5.Refresh()
Sleep(delay)
PictureBox5.Visible = False
i = i + 1
If i = 6 Then
i = 1
End If
End While
End Sub
i wrote the above code. it's working. but the following code is not not working. i want to minimize the code. i want to use 20 picture box. instead of the above code i want to use small code but it will do the same work. please help me.
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
While i <= 5
Dim pic As PictureBox
Dim matches() As Control
matches = Me.Controls.Find("PictureBox" & i.ToString(), True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is Label Then
pic = DirectCast(matches(0), PictureBox)
pic.Visible = True
pic.Refresh()
Sleep(delay)
pic.Visible = False
End If
i = i + 1
If i = 6 Then
i = 1
End If
End While
End Sub
End Class
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
While i <= 5
Dim pic As PictureBox
Dim matches() As Control
matches = Me.Controls.Find("PictureBox" & i.ToString(), True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is PictureBox Then
pic = DirectCast(matches(0), PictureBox)
pic.Visible = True
pic.Refresh()
Wait(delay)
pic.Visible = False
End If
i = i + 1
If i = 6 Then
i = 1
End If
End While
End Sub
this code is correct... sorry i wrote wrong code 1st time.. now it's correct.. thank u all..