Solved

Moving Pixels

Posted on 2004-08-27
9
277 Views
Last Modified: 2010-05-02
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

Private Sub Form_Load()
Xcoord = 400
Ycoord = 100

Speed = 1
Horizontal = 0
Vertical = 1
End Sub

Thanks
0
Comment
Question by:richardsmythe
  • 5
  • 4
9 Comments
 
LVL 85

Expert Comment

by:Mike Tomlinson
Comment Utility
Create a new project and add a PictureBox and a Timer control:

Option Explicit

Private Const radius = 10
Private x As Single
Private y As Single
Private xStep As Single
Private yStep As Single
Private xDir As Boolean
Private yDir As Boolean

Private Sub Form_Load()
    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)
    x = CSng(((Picture1.Width - radius - 2) - radius + 1) * Rnd + radius)
    y = CSng(((Picture1.Height - radius - 2) - radius + 1) * Rnd + radius)
    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
            x = radius
            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
            y = radius
            yDir = Not yDir
        End If
    End If
   
    Picture1.Cls
    Picture1.Circle (x, y), radius, vbBlack
End Sub
0
 

Author Comment

by:richardsmythe
Comment Utility
Heheh good ol' Idle_Mind. What was wrong with my way? would it not have worked?
0
 
LVL 85

Accepted Solution

by:
Mike Tomlinson earned 180 total points
Comment Utility
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 unloading As Boolean
Private radius As Integer

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

Private Sub Form_Load()
    Picture1.ScaleMode = vbPixels
    Xcoord = Picture1.Width / 2
    Ycoord = Picture1.Height / 2
    radius = 10
    Speed = 1
    Horizontal = False
    Vertical = True
    unloading = False
End Sub

Private Sub Command1_Click()
    Do
        If Horizontal Then
            Xcoord = Xcoord - Speed
            If Xcoord < 0 Then
                Xcoord = radius
                Horizontal = Not Horizontal
            End If
        ElseIf Not Horizontal Then
            Xcoord = Xcoord + Speed
            If Xcoord > Picture1.Width - radius Then
                Xcoord = Picture1.Width - radius
                Horizontal = Not Horizontal
            End If
        End If
        If Vertical Then
            Ycoord = Ycoord - Speed
            If Ycoord < 0 Then
                Ycoord = radius
                Vertical = Not Vertical
            End If
        ElseIf Not Vertical Then
            Ycoord = Ycoord + Speed
            If Ycoord > Picture1.Height - radius Then
                Ycoord = Picture1.Height - radius
                Vertical = Not Vertical
            End If
        End If
       
        Picture1.Cls
        Picture1.Circle (Xcoord, Ycoord), 10, vbRed
        Sleep 5
        DoEvents
    Loop While Not unloading
End Sub

Private Sub Form_Unload(Cancel As Integer)
    unloading = True
End Sub
0
 

Author Comment

by:richardsmythe
Comment Utility
i cant get that to work
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:richardsmythe
Comment Utility
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 85

Expert Comment

by:Mike Tomlinson
Comment Utility
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

by:richardsmythe
Comment Utility
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
        If Xcoord <= Left_Paddle.Width Then
       
            If Ycoord >= Left_Paddle.Top And Ycoord <= (Left_Paddle.Top + Left_Paddle.Height) Then
                horizontal = False
                lbl_score.Caption = lbl_score.Caption + 3
            Else
                If Xcoord < -BallRadius Then
                    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 85

Expert Comment

by:Mike Tomlinson
Comment Utility
It would be something like this:

If Not horizontal Then
        Xcoord = Xcoord + Speed
        If Xcoord + BallRadius >= Right_Paddle.Left Then
       
            If Ycoord >= Right_Paddle.Top And Ycoord <= (Right_Paddle.Top + Right_Paddle.Height) Then
                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

by:richardsmythe
Comment Utility
ah youre a star
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
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…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now