I have it so the box can be moved by keyboard, but I want to find out when its touching the wall. it uses a timer and picTure boxes, no BitbLt or anything special.
Printable View
I have it so the box can be moved by keyboard, but I want to find out when its touching the wall. it uses a timer and picTure boxes, no BitbLt or anything special.
Code:Private Sub CheckDetection() '==?===
If picMain.Left = wall.Left Then 'TOOK OUT THE AND CONDITION HERE
wall.BackColor = vbRed 'Turn red when box touches it
Else
wall.BackColor = vbBlue 'turn blue when not touching it
End If
End Sub
'CHANGED THE MOVEMENT VALUE, IT WAS SWITCHING TOO FAST TO SEE THE COLOR CHANGE, AT THIS SPEED YOU CAN SEE IT HAPPEN
Private Sub Moveit()
If duck(0).Facing = 1 Then
duck(0).X = duck(0).X - 1
picMain.Left = duck(0).X
ElseIf duck(0).Facing = 2 Then
duck(0).Y = duck(0).Y - 1
picMain.Top = duck(0).Y
ElseIf duck(0).Facing = 3 Then
duck(0).X = duck(0).X + 1
picMain.Left = duck(0).X
ElseIf duck(0).Facing = 4 Then
duck(0).Y = duck(0).Y + 1
picMain.Top = duck(0).Y
End If
End Sub
hmmM, thanks but there is a problem with this now, See if I pass the square UNDER the line, it still gets touched, I think because it doesnt check for Y, only for X, I wanna be able to go all around the square w/o color change, unless I touch it directly.
Also another thing, It seems to be too little, the "hot spot" Its like 1 pixelx1 pixel, How can I make it so if the edges touch, itll change color, not only if the center touches, thanks!
this works now, also bounces the box off the wall, regardless of which surface, also the space bar stops the box
Code:Option Explicit
Private Type RECT
Left As Long 'upper left x coord
Top As Long 'upper left y coord
Right As Long 'lower right x coord
Bottom As Long 'lower right y coord
End Type
Private Type TEK
X As Long
Y As Long
Facing As Long
End Type
Private Enum DIRECTION
DirLeft = 1
DirUp = 2
DirRight = 3
DirDown = 4
DirStop = 5
End Enum
Private Box As RECT
Private WallDimensions As RECT
Private bHit As Boolean
Dim duck(0) As TEK
Private Sub Form_Load()
Randomize
duck(0).X = Int(Rnd * Form1.ScaleWidth) - 10 '---Start the picMain box
duck(0).Y = Int(Rnd * Form1.ScaleHeight) - 10 'anywhere within the form
picMain.Left = duck(0).X 'randomLy
picMain.Top = duck(0).Y '-------------------------------
GetBoxBounds
GetWallBounds
bHit = False
End Sub
Private Sub GetWallBounds()
With WallDimensions
.Left = wall.Top
.Top = wall.Left
.Right = wall.Top + wall.Height
.Bottom = wall.Left + wall.Width
End With
End Sub
Private Sub GetBoxBounds()
With Box
.Left = picMain.Top
.Top = picMain.Left
.Right = picMain.Top + picMain.Height
.Bottom = picMain.Left + picMain.Width
End With
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyLeft Then 'Left
duck(0).Facing = DirLeft
ElseIf KeyCode = vbKeyUp Then 'Up
duck(0).Facing = DirUp
ElseIf KeyCode = vbKeyRight Then 'Right
duck(0).Facing = DirRight
ElseIf KeyCode = vbKeyDown Then 'Down
duck(0).Facing = DirDown
ElseIf KeyCode = vbKeySpace Then
duck(0).Facing = DirStop
End If
End Sub
Private Sub Timer1_Timer()
Call Moveit
Call CheckDetection
End Sub
Private Sub CheckCollision()
'check for left of box on right of wall, check for below top of wall, then bottom of wall
If Box.Top = WallDimensions.Bottom And (Box.Right >= WallDimensions.Left And Box.Left <= WallDimensions.Right) Then
bHit = True
ReverseDirection
'check for right of box on left of wall, check for below top of wall, then bottom of wall
ElseIf Box.Bottom = WallDimensions.Top And (Box.Right >= WallDimensions.Left And Box.Left <= WallDimensions.Right) Then
bHit = True
ReverseDirection
'check for bottom of box on top of wall, then within left of wall, then within right of wall
ElseIf Box.Right = WallDimensions.Left And (Box.Bottom >= WallDimensions.Top And Box.Top <= WallDimensions.Bottom) Then
bHit = True
ReverseDirection
'check for top of box on bottom of wall, then within left of wall, then within right of wall
ElseIf Box.Left = WallDimensions.Right And (Box.Bottom >= WallDimensions.Top And Box.Top <= WallDimensions.Bottom) Then
bHit = True
ReverseDirection
Else
bHit = False
End If
End Sub
Private Sub ReverseDirection()
Select Case duck(0).Facing
Case DirUp
duck(0).Facing = DirDown
Case DirDown
duck(0).Facing = DirUp
Case DirRight
duck(0).Facing = DirLeft
Case DirLeft
duck(0).Facing = DirRight
End Select
End Sub
Private Sub CheckDetection() '==?===
CheckCollision
If bHit Then
wall.BackColor = vbRed 'Turn red when box touches it
Else
wall.BackColor = vbBlue 'turn blue when not touching it
End If
End Sub
Private Sub Moveit()
If duck(0).Facing = DirLeft Then
duck(0).X = duck(0).X - 1
picMain.Left = duck(0).X
GetBoxBounds
ElseIf duck(0).Facing = DirUp Then
duck(0).Y = duck(0).Y - 1
picMain.Top = duck(0).Y
GetBoxBounds
ElseIf duck(0).Facing = DirRight Then
duck(0).X = duck(0).X + 1
picMain.Left = duck(0).X
GetBoxBounds
ElseIf duck(0).Facing = DirDown Then
duck(0).Y = duck(0).Y + 1
picMain.Top = duck(0).Y
GetBoxBounds
End If
End Sub
ThanKs
no problem