shiny
asked on
I hate VB!! ;)
Okay, I am working on this program right and its not working right. Its an asteroids like thing but i can not get the asteroids to blow up when you hit them with your laser, nor can i get you to die when they hit you.
I have a copy at
http://www.gamepl.com/space.zip
(250k)
I have a copy at
http://www.gamepl.com/space.zip
(250k)
Sorry, change this string
If Abs(LaserX + Laser.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 15 Then
(was Asteroid(RockNum).Height)
If Abs(LaserX + Laser.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 15 Then
(was Asteroid(RockNum).Height)
Place this just before "Hit to die Code"
If Abs(YDest + Ship.Height - RockYPos - 20) < 5 Then
If Abs(XDest + Ship.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 15 Then
MsgBox "Booooommmm !!!", vbCritical
frmGame.Show 'Temp until this works right
End If
End If
If Abs(YDest + Ship.Height - RockYPos - 20) < 5 Then
If Abs(XDest + Ship.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 15 Then
MsgBox "Booooommmm !!!", vbCritical
frmGame.Show 'Temp until this works right
End If
End If
Ok, now all together:
Change Mouse_Move,Mouse_Down and Key_Down events as I wrote before.
'Change this part: IF HIT THEN DIE CODE (not even close to remotely trying to work)
' ========================== ========== ========== ===
If Abs(YDest + Ship.Height - RockYPos - 20) < 5 Then
If Abs(XDest + Ship.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 15 Then
MsgBox "Booooommmm !!!", vbCritical
End If
End If
If Abs(LaserY + Laser.Height - 12 - RockYPos) < 5 And LaserY > 0 Then
If Abs(LaserX + Laser.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 10 Then
MsgBox "Nice shoot!!!", vbExclamation
End If
End If
Change Mouse_Move,Mouse_Down and Key_Down events as I wrote before.
'Change this part: IF HIT THEN DIE CODE (not even close to remotely trying to work)
' ==========================
If Abs(YDest + Ship.Height - RockYPos - 20) < 5 Then
If Abs(XDest + Ship.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 15 Then
MsgBox "Booooommmm !!!", vbCritical
End If
End If
If Abs(LaserY + Laser.Height - 12 - RockYPos) < 5 And LaserY > 0 Then
If Abs(LaserX + Laser.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 10 Then
MsgBox "Nice shoot!!!", vbExclamation
End If
End If
I do Collision checks in all of my games
Now I tried to download your zip file but i cant get it so this probally wont work
But it works really well for me.
in the form
Public Function Collision(spr1 As _ Sprite, spr2 As Sprite) As Boolean
Collision = True
' Sets the collision as True
'Now we see if the collision impossible:
'one line
If spr1.YCoord > spr2.YCoord + _ spr2.CollisionHeight Then Collision _ =False
'one line
If spr1.YCoord + spr1.CollisionHeight _ < spr2.YCoord Then Collision = False
'one line
If spr1.XCoord + spr1.CollisionWidth _
< spr2.XCoord Then Collision = False
'one line
If spr1.XCoord > spr2.XCoord + _ spr2.CollisionWidth Then Collision = _ False
End Function
Now In your timer
If Collision(Laser, Rock) Then
'What ever you want it to do
'Hit
Else
'Not a damb thing
End If
'If your useing sprites this will work
'If not this is no help
'The collision width and height
'are the sprites width and height
Now I tried to download your zip file but i cant get it so this probally wont work
But it works really well for me.
in the form
Public Function Collision(spr1 As _ Sprite, spr2 As Sprite) As Boolean
Collision = True
' Sets the collision as True
'Now we see if the collision impossible:
'one line
If spr1.YCoord > spr2.YCoord + _ spr2.CollisionHeight Then Collision _ =False
'one line
If spr1.YCoord + spr1.CollisionHeight _ < spr2.YCoord Then Collision = False
'one line
If spr1.XCoord + spr1.CollisionWidth _
< spr2.XCoord Then Collision = False
'one line
If spr1.XCoord > spr2.XCoord + _ spr2.CollisionWidth Then Collision = _ False
End Function
Now In your timer
If Collision(Laser, Rock) Then
'What ever you want it to do
'Hit
Else
'Not a damb thing
End If
'If your useing sprites this will work
'If not this is no help
'The collision width and height
'are the sprites width and height
ASKER
Ark, thank you a lot for your help, when the asteroid hits you, 'boom' ;) but nothing happens when the laser hits the asteroid. Is there a way that I can give you partial points for all your help so far?
Hi
I don't know about partial points. But it's strange that there is no effect when laser hits asteroid.
Here is form code (without declarations)
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyEscape
'Returns to other form, stops sound
j = sndPlaySound(vbNullString, SND_ASYNC)
frmStart.Show
frmGame.Hide
Case vbKeySpace
'Allows the space bar to shoot too
ShootLaser = True
LaserX = XDest + Ship.Width / 2 - Laser.Width / 2
LaserY = YDest + Ship.Height - 20
End Select
End Sub
Private Sub Form_Load()
Show
RockYPos = 425
For XLoader = 1 To x
Randomize Timer
RandX = Int(Rnd * x + 1)
StarXPos(XLoader) = RandX
Next XLoader
For YLoader = 1 To x
StarYPos(YLoader) = YLoader
Next YLoader
'Play sound
'j = sndPlaySound(App.Path + "\Needle.wav", SND_ASYNC Or SND_LOOP)
Do
DoEvents
Cls
For i = 1 To (x - 1)
StarXPos(i) = StarXPos(i + 1)
Next i
For i = 1 To x
PSet (StarXPos(i), StarYPos(i)), vbWhite
Next i
RandX = Int(Rnd * x + 1)
StarXPos(x) = RandX
'Draw Ship
j = BitBlt(Me.hDC, XDest, YDest, 150, 112, ShipMask.hDC, 0, 0, vbSrcAnd)
j = BitBlt(Me.hDC, XDest, YDest, 150, 112, Ship.hDC, 0, 0, vbSrcPaint)
If ShootLaser = True Then 'If the laser has been activated then:
j = BitBlt(Me.hDC, LaserX, LaserY, 150, 112, LaserMask.hDC, 0, 0, vbSrcAnd)
j = BitBlt(Me.hDC, LaserX, LaserY, 150, 112, Laser.hDC, 0, 0, vbSrcPaint)
LaserY = LaserY + 10
If LaserY >= Me.ScaleHeight Then
ShootLaser = False
LaserY = 0
End If
End If
' ASTEROID STUFF
' ========================== ========== ========== ===
RockYPos = RockYPos - 5
If RockYPos + 100 <= 0 Then
RockYPos = 425
RockXPos = Int(Rnd * Me.ScaleWidth)
RockNum = Int(Rnd * 4)
End If
j = BitBlt(Me.hDC, RockXPos, RockYPos, 150, 112, AsteroidMask(RockNum).hDC, 0, 0, vbSrcAnd)
j = BitBlt(Me.hDC, RockXPos, RockYPos, 150, 112, Asteroid(RockNum).hDC, 0, 0, vbSrcPaint)
' ========================== ========== ========== ===
' IF HIT THEN DIE CODE (not even close to remotely trying to work)
' ========================== ========== ========== ===
If Abs(YDest + Ship.Height - RockYPos - 20) < 5 Then
If Abs(XDest + Ship.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 15 Then
MsgBox "Booooommmm !!!", vbCritical
End If
End If
'You cahnge asteroid pos by 5 and laser by 10, so every loop distance change by 15 - you need check abs < 15/2 = 8
If Abs(LaserY + Laser.Height - 12 - RockYPos) < 8 And LaserY > 0 Then
' Check if laser find asteroid
If Abs(LaserX + Laser.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < Asteroid(RockNum).Width / 2 Then
MsgBox "Nice shoot!!!", vbExclamation
End If
End If
' (I tryed (Derek))
' ========================== ========== ========== ===
Loop
End Sub
Public Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
ShootLaser = True
LaserX = XDest + Ship.Width / 2 - Laser.Width / 2
LaserY = YDest + Ship.Height - 20
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
XDest = x - Ship.Width / 2
End Sub
Cheers
I don't know about partial points. But it's strange that there is no effect when laser hits asteroid.
Here is form code (without declarations)
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyEscape
'Returns to other form, stops sound
j = sndPlaySound(vbNullString,
frmStart.Show
frmGame.Hide
Case vbKeySpace
'Allows the space bar to shoot too
ShootLaser = True
LaserX = XDest + Ship.Width / 2 - Laser.Width / 2
LaserY = YDest + Ship.Height - 20
End Select
End Sub
Private Sub Form_Load()
Show
RockYPos = 425
For XLoader = 1 To x
Randomize Timer
RandX = Int(Rnd * x + 1)
StarXPos(XLoader) = RandX
Next XLoader
For YLoader = 1 To x
StarYPos(YLoader) = YLoader
Next YLoader
'Play sound
'j = sndPlaySound(App.Path + "\Needle.wav", SND_ASYNC Or SND_LOOP)
Do
DoEvents
Cls
For i = 1 To (x - 1)
StarXPos(i) = StarXPos(i + 1)
Next i
For i = 1 To x
PSet (StarXPos(i), StarYPos(i)), vbWhite
Next i
RandX = Int(Rnd * x + 1)
StarXPos(x) = RandX
'Draw Ship
j = BitBlt(Me.hDC, XDest, YDest, 150, 112, ShipMask.hDC, 0, 0, vbSrcAnd)
j = BitBlt(Me.hDC, XDest, YDest, 150, 112, Ship.hDC, 0, 0, vbSrcPaint)
If ShootLaser = True Then 'If the laser has been activated then:
j = BitBlt(Me.hDC, LaserX, LaserY, 150, 112, LaserMask.hDC, 0, 0, vbSrcAnd)
j = BitBlt(Me.hDC, LaserX, LaserY, 150, 112, Laser.hDC, 0, 0, vbSrcPaint)
LaserY = LaserY + 10
If LaserY >= Me.ScaleHeight Then
ShootLaser = False
LaserY = 0
End If
End If
' ASTEROID STUFF
' ==========================
RockYPos = RockYPos - 5
If RockYPos + 100 <= 0 Then
RockYPos = 425
RockXPos = Int(Rnd * Me.ScaleWidth)
RockNum = Int(Rnd * 4)
End If
j = BitBlt(Me.hDC, RockXPos, RockYPos, 150, 112, AsteroidMask(RockNum).hDC,
j = BitBlt(Me.hDC, RockXPos, RockYPos, 150, 112, Asteroid(RockNum).hDC, 0, 0, vbSrcPaint)
' ==========================
' IF HIT THEN DIE CODE (not even close to remotely trying to work)
' ==========================
If Abs(YDest + Ship.Height - RockYPos - 20) < 5 Then
If Abs(XDest + Ship.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < 15 Then
MsgBox "Booooommmm !!!", vbCritical
End If
End If
'You cahnge asteroid pos by 5 and laser by 10, so every loop distance change by 15 - you need check abs < 15/2 = 8
If Abs(LaserY + Laser.Height - 12 - RockYPos) < 8 And LaserY > 0 Then
' Check if laser find asteroid
If Abs(LaserX + Laser.Width / 2 - RockXPos - Asteroid(RockNum).Width / 2) < Asteroid(RockNum).Width / 2 Then
MsgBox "Nice shoot!!!", vbExclamation
End If
End If
' (I tryed (Derek))
' ==========================
Loop
End Sub
Public Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
ShootLaser = True
LaserX = XDest + Ship.Width / 2 - Laser.Width / 2
LaserY = YDest + Ship.Height - 20
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
XDest = x - Ship.Width / 2
End Sub
Cheers
PS. First code hits asteroid only in centre, last one - in any part
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Adjusted points from 729 to 730
ASKER
Thank you so much, I have spent many hours working with this.
-Shiny (shiny@gamepl.com)
-Shiny (shiny@gamepl.com)
Glad to help you!
BTW, if change 20 to 25:
If Abs(YDest + Ship.Height - RockYPos - 25 - iTemp) < 5 Then
Collision will be more closely
Cheers
BTW, if change 20 to 25:
If Abs(YDest + Ship.Height - RockYPos - 25 - iTemp) < 5 Then
Collision will be more closely
Cheers
You forgot Asteroid and laser size
Take a look - I change:
'I'm not a very good shooter, so I increase IF statement to 10 pixels
' IF HIT THEN DIE CODE (not even close to remotely trying to work)
' =======
If Abs(LaserY + Laser.Height - 8 - RockYPos) < 10 And LaserY > 0 Then
If Abs(LaserX + Laser.Width / 2 - RockXPos - Asteroid(RockNum).Height / 2) < 10 Then
frmGame.Show 'Temp until this works right
End If
End If
' (I tryed (Derek))
'More changes:
Public Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
ShootLaser = True
LaserX = XDest + Ship.Width / 2 - Laser.Width / 2
LaserY = YDest + Ship.Height - 20
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
XDest = x - Ship.Width / 2
End Sub
' From Key-Down Event
Case vbKeySpace
'Allows the space bar to shoot too
ShootLaser = True
LaserX = XDest + Ship.Width / 2 - Laser.Width / 2
LaserY = YDest + Ship.Height - 20