Solved

# Moving Pixels

Posted on 2004-08-27
Medium Priority
292 Views
Hi

I need a cirlce of pixels to move around the picture box bouncing of the walls. So far I have got it to move but I am stuck as from what I do now.
Here is what I have done so far...

Dim Horizontal As Boolean
Dim Vertical As Boolean
Dim Xcoord As Integer
Dim Ycoord  As Integer
Dim Speed As Integer

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()

Do
Sleep 5

If Horizontal = 0 Then Xcoord = Xcoord - Speed
If Horizontal = 1 Then Xcoord = Xcoord + Speed
If Vertical = 0 Then Ycoord = Ycoord + Speed
If Vertical = 1 Then Ycoord = Ycoord - Speed

Picture1.Cls
Picture1.Circle (Xcoord, Ycoord), 10, vbRed
DoEvents

Loop

End Sub

Xcoord = 400
Ycoord = 100

Speed = 1
Horizontal = 0
Vertical = 1
End Sub

Thanks
0
Question by:richardsmythe
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 5
• 4

LVL 86

Expert Comment

ID: 11916999
Create a new project and add a PictureBox and a Timer control:

Option Explicit

Private x As Single
Private y As Single
Private xStep As Single
Private yStep As Single
Private xDir As Boolean
Private yDir As Boolean

Timer1.Enabled = False
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture1.Appearance = 0 ' flat
Picture1.BorderStyle = 1 ' fixed single
Randomize Timer
' Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
xStep = 5
yStep = 5
If Rnd <= 0.5 Then
xDir = True
Else
xDir = False
End If
If Rnd <= 0.5 Then
yDir = True
Else
yDir = False
End If
Timer1.Interval = 25
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
If xDir Then
If x + xStep <= Picture1.Width - radius - 2 Then
x = x + xStep
Else
x = Picture1.Width - radius - 2
xDir = Not xDir
End If
Else
If x - xStep >= radius Then
x = x - xStep
Else
xDir = Not xDir
End If
End If

If yDir Then
If y + yStep <= Picture1.Height - radius - 2 Then
y = y + yStep
Else
y = Picture1.Height - radius - 2
yDir = Not yDir
End If
Else
If y - yStep >= radius Then
y = y - yStep
Else
yDir = Not yDir
End If
End If

Picture1.Cls
End Sub
0

Author Comment

ID: 11917007
Heheh good ol' Idle_Mind. What was wrong with my way? would it not have worked?
0

LVL 86

Accepted Solution

Mike Tomlinson earned 720 total points
ID: 11917121
It just need a little tweaking...  I avoid the sleep API if I can.

Here is wha it would look like using your model:

Option Explicit

Private Horizontal As Boolean
Private Vertical As Boolean
Private Xcoord As Integer
Private Ycoord  As Integer
Private Speed As Integer

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Picture1.ScaleMode = vbPixels
Xcoord = Picture1.Width / 2
Ycoord = Picture1.Height / 2
Speed = 1
Horizontal = False
Vertical = True
End Sub

Private Sub Command1_Click()
Do
If Horizontal Then
Xcoord = Xcoord - Speed
If Xcoord < 0 Then
Horizontal = Not Horizontal
End If
ElseIf Not Horizontal Then
Xcoord = Xcoord + Speed
If Xcoord > Picture1.Width - radius Then
Horizontal = Not Horizontal
End If
End If
If Vertical Then
Ycoord = Ycoord - Speed
If Ycoord < 0 Then
Vertical = Not Vertical
End If
ElseIf Not Vertical Then
Ycoord = Ycoord + Speed
If Ycoord > Picture1.Height - radius Then
Vertical = Not Vertical
End If
End If

Picture1.Cls
Picture1.Circle (Xcoord, Ycoord), 10, vbRed
Sleep 5
DoEvents
End Sub

End Sub
0

Author Comment

ID: 11917509
i cant get that to work
0

Author Comment

ID: 11945028
Is it possible in VB to test the current pixel colour in a particular situation. eg if pixel colour = black then do something.
0

LVL 86

Expert Comment

ID: 11945822
Private Sub Command1_Click()
Dim pixelColor As Long

' grab the color of the point at (100, 100) in Picture1
pixelColor = Picture1.Point(100, 100)

' like this...

If pixelColor = vbBlack Then
' do something
End If

' or this...

Dim r, g, b As Byte
Red = pixelColor Mod 256
Green = (pixelColor \ 256) Mod 256
Blue = (pixelColor \ 65536) Mod 256
If Red = 0 And Green = 0 And Blue = 0 Then
' do something
End If
End Sub
0

Author Comment

ID: 11953826
Cool. In my pong came I am trying to get that pixel circle thing to bounce off padles. I have paddles on all sides of the form. left, bottom, right, top. I got the left side to work so that It bounces off the paddle and its game over if it doesnt. But I cant seem to get the other sides to work.

If horizontal Then
Xcoord = Xcoord - Speed
'If Xcoord = BallRadius Then horizontal = False

horizontal = False
lbl_score.Caption = lbl_score.Caption + 3
Else
MsgBox "Game over"
End If
End If
End If

Thats for the left side. But my attempts at doing the other sides dont worK :(
0

LVL 86

Expert Comment

ID: 11953904
It would be something like this:

If Not horizontal Then
Xcoord = Xcoord + Speed

horizontal = true
lbl_score.Caption = lbl_score.Caption + 3
Else
If Xcoord >= Picture1.Width - BallRadius Then
MsgBox "Game over"
End If
End If
End If

0

Author Comment

ID: 11957957
ah youre a star
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
###### Suggested Courses
Course of the Month15 days, 3 hours left to enroll