Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.basic.visual.misc > #717

Re: Scrollbar 'Freeze'

Show all headers | View raw

"xyzzy" <xyzzy1974@gmail.com> wrote in message 
news:906f3a4b-3563-41e5-9143-0d861848058a@c8g2000yqc.googlegroups.com...
> Hi
>
> I've been scratching my head as to why in this little VB6 program
> simulating (not very accurately!) gravity the two scrollbars accept
> one change event but then 'freeze' up. I though it was something to do
> with calling Form_Activate, but if I use a command button to perform
> the same function it works fine.

Your Form_Activate is running a never-ending loop; when you call it again 
you now have 2 never-ending loops running although the first is hung up 
waiting for the second to finish.  Every scrollbar change triggers another; 
you should use a flag to tell your routine to refresh with new values rather 
than calling it again.

> Source code below. Can also be downloaded at: 
> http://leobs.net/Bouncing%20Ball_Src.rar
>
> Regards
>
> Leo
> -----------
> ' 'Bouncing Ball' by Leo Bramwell-Speer...
> '
> '
> Option Explicit
> Dim BallX, BallY, OldBallX, OldBallY, Gravity, Xmomentum, Ymomentum,
> Mass, Time As Single, LeftToRight, Falling As Boolean

The above declaration creates 9 variants, 1 single, and 1 boolean;I don't 
think that's what you want.  You have to use the "As" clause or a type 
suffix character on every variable to avoid using variants.

> Time = Timer

'Time' is a VB function; you can re-use the name as avariable but it makes 
the code harder to read

> Do
> DoEvents
> Loop Until Timer - Time >= 2

Using 'Timer' for a delay can cause problems if you happen to be running it 
when it resets

> Private Sub Form_Unload(Cancel As Integer)
> End
> End Sub

Don't use END; there are situations where it does not allow applications to 
clean up correctly.  It is never needed and can result in memory/resource 
leaks.  Use another flag to tell your loops to shut down and let the form 
unload and the app exit gracefully.

It's too late now and I'm too tired to figure out exactly what this is 
supposed to be doing (the xmomentum seems to dampen way too much too fast) 
but this code doesn't freeze up and exits cleanly without using End:

Option Explicit
Private mbUnload As Boolean
Private mbRestart As Boolean

Private Sub Form_Activate()
Dim dNow As Date
Dim BallX!, BallY!, OldBallX!, OldBallY!, Gravity!, Xmomentum!, Ymomentum!, 
Mass As Single
Dim LeftToRight As Boolean, Falling As Boolean
Do
  mbRestart = False
  Gravity = vsbGravity.Value
  Mass = vsbMass.Value
  Me.DrawWidth = Mass * 3 ' 30
  Xmomentum = 10
  Ymomentum = 0
  BallX = Me.DrawWidth / 2
  BallY = Me.DrawWidth / 2
  LeftToRight = True
  Falling = True
  Me.Cls
  Me.PSet (BallX, BallY)
  Do
    OldBallX = BallX
    OldBallY = BallY
    If Falling Then
      Ymomentum = Ymomentum + Gravity * Mass
    Else
      Ymomentum = Ymomentum - Gravity * Mass
    End If
    If Ymomentum <= 0 Then Falling = True
    If Falling Then
      BallY = BallY + Ymomentum * Gravity
    Else
      BallY = BallY - Ymomentum * Gravity
    End If
    If BallY >= Me.ScaleHeight - Me.DrawWidth / 2 Then
      BallY = Me.ScaleHeight - Me.DrawWidth / 2
      Falling = False
    End If
    If LeftToRight Then BallX = BallX + Xmomentum
    If LeftToRight = False Then BallX = BallX - Xmomentum
    If Xmomentum >= 0 Then Xmomentum = Xmomentum - Gravity / 100
    If BallX <= 0 + Me.DrawWidth / 2 Then LeftToRight = True
    If BallX >= Me.ScaleWidth - Me.DrawWidth / 2 Then LeftToRight = False
    Me.PSet (OldBallX, OldBallY)
    Me.PSet (BallX, BallY)
    Me.Refresh
    DoEvents
    If mbUnload Or mbRestart Then Exit Do
  Loop Until Ymomentum = 0 And BallY = Me.ScaleHeight - Me.DrawWidth / 2
  dNow = Now
  Do Until mbUnload Or mbRestart Or DateDiff("s", dNow, Now)
   DoEvents
  Loop
Loop Until mbUnload
End Sub

Private Sub Form_Load()
Me.AutoRedraw = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
mbUnload = True
End Sub

Private Sub vsbGravity_Change()
mbRestart = True
End Sub

Private Sub vsbMass_Change()
mbRestart = True
End Sub

Back to comp.lang.basic.visual.misc | Previous | Next — Previous in thread | Next in thread | Find similar

Thread

Scrollbar 'Freeze' xyzzy <xyzzy1974@gmail.com> - 2012-01-23 18:25 -0800
  Re: Scrollbar 'Freeze' "Bob Butler" <bob_butler@cox.invalid> - 2012-01-23 22:07 -0800
    Re: Scrollbar 'Freeze' xyzzy <xyzzy1974@gmail.com> - 2012-01-24 04:19 -0800
      Re: Scrollbar 'Freeze' "Bob Butler" <bob_butler@cox.invalid> - 2012-01-24 08:59 -0800
        Re: Scrollbar 'Freeze' xyzzy <xyzzy1974@gmail.com> - 2012-01-24 12:13 -0800

csiph-web