PDA

View Full Version : Using accelerometers in VB6



Mooncinder
03-01-2007, 08:23 AM
I am currently making a game that involves using an accelerometer to activate a paddle to catch a ball. There are three paddles and three balls which drop randomly, one at a time. At the moment, the ball code works fine and the accelerometer code works fine but I'm having trouble getting them to work together. The code for the ball is in a while loop which checks whether the ball has reached the paddle. If it hasn't, the ball moves toward the paddle a bit and then sleeps for 100 (so that the user can see the ball moving).


Dim a as Long
Dim b as Double
While ball1(0).Top < Shape1.Top 'while the ball hasn't reached the paddle
ball1(0).Top = ball1(0).Top + 200 'move the ball down
Sleep 100
Call Accel_OnAccelerationChange(a, b)**

If pos = "left" Then
var = 1 'activate left paddle
ElseIf pos = "right" Then
var = 2 'activate right paddle
ElseIf pos = "centre" Then
var = 3 'activate centre paddle
End If

Wend

** I tried calling the accelerometer sub routine but wasn't sure what I needed to put in the brackets. The values a and b seem to set the x value and the acceleration to 0 for some reason.

Unfortunately, while it's stuck in this while loop it isn't reading the accelerometer code so the values freeze, making it impossible to for the user to catch the ball. To me, the only way I can think to fix this problem is to use multithreading but I'm not too keen on the idea of using it because I've never used multithreading before and I've heard it can be a bit temperamental in VB.

Can anyone think of a better way to get the program to keep updating the accelerometer values while moving the ball without using multithreading or is it really the only way?

Mooncinder
03-02-2007, 10:03 AM
Nevermind, I (finally) found someone who showed me how to use a timer to controll the ball movement so that it would work alongside the accelerometer.

Alex
03-02-2007, 10:32 AM
Hey Mooncider,

Great to hear you figured out how to get it to work. Sorry we didn't get back to you:(

Could you possibly post your findings so that others could see how you solved the problem?

Mooncinder
03-03-2007, 10:42 AM
Of course. :) Here is the new code that controls the balls:


Private Sub movement_Timer()
If dropping = True Then 'if a ball is already dropping
If dropping_ball = 0 Then
ball1(0).Top = ball1(0).Top + 200

If XOut >= 2.5 Then
pos = "left"
ElseIf XOut <= -2.5 Then
pos = "right"
ElseIf XOut < 2.5 And XOut > -2.5 Then
pos = "centre"
End If

If ball1(0).Top > Shape1.Top Then 'when the ball has reached the paddle
If pos = "left" Then
txScore = txScore + 10
lbResult = "Caught!"
Else
lbResult = "Missed"
End If
ball1(0).Top = guide1.Top 'reset position of ball
dropping = False
End If
End If

If dropping_ball = 1 Then
ball2(0).Top = ball2(0).Top + 200

If pos = "centre" Then
txScore = txScore + 10
lbResult = "Caught!"
Else
lbResult = "Missed"
End If
ball2(0).Top = guide2.Top
dropping = False
End If

If dropping_ball = 2 Then
ball3(0).Top = ball3(0).Top + 200

If pos = "right" Then
txScore = txScore + 10
lbResult = "Caught!"
Else
lbResult = "Missed"
End If
ball3(0).Top = guide3.Top
dropping = False
End If
End If
End Sub

Private Sub Timer1_Timer()
Dim randNum As Integer

If startFlag = False Then
Exit Sub
End If

txTime = txTime - 1

If txTime = 0 Then 'display a message box when the game is over
msg = MsgBox("Your game is over " _
& Chr(13) + Chr(10) & "Your Score is :" & txScore _
& Chr(13) + Chr(10) & "Would you like to play again? ", vbYesNo)

If msg = vbYes Then 'if the user wants to play again, reset everything
txScore = 0
txTime = 30
Else
End
End If
End If

If dropping = False Then 'if no ball is dropping
RandomNumber 'generate a random number
dropping_ball = randNum
dropping = True 'drop a ball
End If

Label7.Caption = randNum
End Sub
Before, I had everything here in the timer1 sub routine which is the timer that times 30 seconds and then displays the player's score and I used a while loop that would loop until the ball had reached the paddle. This meant that the program was always stuck in this while loop and had no chance to check the accelerometer at all. By using a second timer (movement_Timer) to control the balls, the other timer was free to run through the rest of the program rather than being stuck in a while loop. I also added dropping and dropping_ball to keep track of whether a ball was dropping and if so, which one.

I hope this all makes sense! Unfortunately, now that I've solved one problem, it's Murphy's Law that I should find another one. :mad:

My program decides which paddle the accelerometer is activating by taking the value of the X axis (XOut):


Private Sub Accel_OnAccelerationChange(ByVal index As Long, ByVal acceleration As Double)
Dim I As Integer

' Erase the old line
Form1.Line (XCenter, YCenter)-(X1Old, Y1Old), &H8000000F

If index = 0 Then
XOut = 0 'position the line on the x axis
XFilt(6) = acceleration 'how far left or right the line moves
For I = 0 To 5
XFilt(I) = XFilt(I + 1)
XOut = XOut + XFilt(I)
Label1.Caption = XOut
Next I
XOut = XOut / 6
End If
If index = 1 Then
YOut = 0 'position the line on the y axis
YFilt(6) = acceleration 'how far up or down the line moves
For I = 0 To 5
YFilt(I) = YFilt(I + 1)
YOut = YOut + YFilt(I)
Label2.Caption = YOut
Next I
YOut = YOut / 6
End If

Label3.Caption = acceleration

If XOut >= 2.5 Then
pos = "left"
ElseIf XOut <= -2.5 Then
pos = "right"
ElseIf XOut < 2.5 And XOut > -2.5 Then
pos = "centre"
End If

X1Old = XCenter - XOut * 1000 'calculate coords for x axis
Y1Old = YCenter + YOut * 1000 'calculate coords for y axis
Form1.Line (XCenter, YCenter)-(X1Old, Y1Old)
Form1.Circle (XCenter, YCenter), 1000, vbBlue
End SubI have a label on the form that outputs XOut so I know that the value is right yet pos is always 'centre', even when XOut is clearly not between 2.5 and -2.5. I'd really appreciate it if anyone could tell me why this isn't working.

Sorry for the long post,
Mooncinder

Alex
03-06-2007, 01:50 PM
That's because of where you're trying to test the XOut value. Try this instead:


Private Sub Accel_OnAccelerationChange(ByVal Index As Long, ByVal Acceleration As Double)
Dim I As Integer

' Erase the old line

Form1.Line (XCenter, YCenter)-(X1Old, Y1Old), &H8000000F

If Index = 0 Then
XOut = 0 'position the line on the x axis
XFilt(6) = Acceleration 'how far left or right the line moves
For I = 0 To 5
XFilt(I) = XFilt(I + 1)
XOut = XOut + XFilt(I)

Label1.Caption = XOut

Next I
Dim pos As String
If XOut >= 2.5 Then
pos = "left"
ElseIf XOut <= -2.5 Then
pos = "right"
ElseIf XOut < 2.5 And XOut > -2.5 Then
pos = "centre"
End If

Label4.Caption = pos

XOut = XOut / 6
End If
If Index = 1 Then
YOut = 0 'position the line on the y axis
YFilt(6) = Acceleration 'how far up or down the line moves
For I = 0 To 5
YFilt(I) = YFilt(I + 1)
YOut = YOut + YFilt(I)
Label2.Caption = YOut
Next I
YOut = YOut / 6
End If

Label3.Caption = Acceleration

X1Old = XCenter - XOut * 1000 'calculate coords for x axis
Y1Old = YCenter + YOut * 1000 'calculate coords for y axis
Form1.Line (XCenter, YCenter)-(X1Old, Y1Old)
Form1.Circle (XCenter, YCenter), 1000, vbBlue

End Sub

Mooncinder
03-07-2007, 08:10 AM
Thank you, Alex. That solved the problem. :)