gambas-source-code/app/examples/Drawing/Gravity/.src/FMain.class

' Gambas class file

' Written by Iman Karim
' http://home.inf.fh-rhein-sieg.de/~ikarim2s/
' 14.11.2006

Private Objects As New Collection
Private world_Gravity As Float = 0.9
Private world_Bounce As Float = 0.7
Private world_SlideFloor As Float = 0.9
Private isDrawing As Boolean

Private Sub AddBall(Optional x As Integer = -1, Optional y As Integer = -1)
  Dim cBall As New CBall
  If x = -1 Then
    cBall.x = Rnd(1, 100)
    cBall.y = Rnd(1, 100)
  Else
    cBall.x = x
    cBall.y = y
  End If
  cBall.ax = Rnd(-100, 100)
  cBall.col = Rnd(1, 90000000)
  objects.Add(cBall, Str(objects.Count + 1))
  cB.Add(Str(objects.Count))
End


Private Sub DoGravity()
  Dim myBall As CBall
  For Each myBall In Objects
      If togGrav.value Then myBall.ay = myBall.ay + world_Gravity '// Make Gravity
      myBall.x = myBall.x + myBall.ax '// Move Ball
      myBall.y = myBall.y + myBall.ay
      If myBall.x >= dW.width - 5 Or myBall.x <= 0 Then '// Ball collidated on wall (left/right)
        myBall.ax = (myBall.ax * world_Bounce) * -1 '// Reverse Ball direction and include world_Bounce
      End If
      If myBall.y > dW.Height - 10 Or myBall.y < 10 Then '// Ball collidated on Floor or Sky
        If myball.y < 10 And togSky.value = False Then myball.ay = (myball.ay * world_Bounce) * -1 '// If Sky is disabled no not bounce
        If myball.y > 10 Then myball.ay = (myball.ay * world_Bounce) * -1 '// On floor make bounce for sure
      End If
      If (((dW.Height - 10) - myBall.y) <= 1) And (Abs(myBall.ay) <= 2) And togGrav.Value Then '// If ball is n floor and to slow to jump up again stop the ball (y)
        myball.y = (dW.Height - 10)
        myball.ay = 0
      End If

      If myball.ay = 0 And myball.y = (dW.Height - 10) Then '// If ball is already on floor decrease the roll speed depending on world_SlideFloor factor.
        If myball.ax < 0.1 Then
          myball.ax = Abs(myball.ax) * world_SlideFloor * -1
        Else If myball.ax > 0.1 Then
          myball.ax = Abs(myball.ax) * world_SlideFloor 
        Else 
          myball.ax = 0 '// If ball is moving to slow stop it
        End If
      End If

      If myball.y > dW.Height - 10 Then '// Make sure befor painting that the ball is inside your viewport. (floor)
        myball.y = dW.Height - 10
      Else If myball.y <= 10 And togSky.Value = False Then 
        myball.y = 12
      End If
      If myball.x > dW.width - 5 Then '// Make sure befor painting that the ball is inside your viewport. (left\right wall)
        myball.x = dW.Width - 5
      Else If myball.x < 0 Then 
        myball.x = 0
      End If  
  Next 
End

Private Sub DrawWorld()
  Dim myBall As CBall  
  Dim index As Integer
  If isDrawing = False Then
    isDrawing = True
    Try Draw.begin(dW)
    'Draw.Rect(3, 12, dW.Width - 6, dW.Height - 17)
    Draw.FillStyle = 1
    Draw.FillColor = Color.White
    For Each myBall In Objects
      index = index + 1
      Draw.Foreground = myBall.col
      Draw.Ellipse(myBall.x, myBall.y, 5, 5) 
      If Str(index) = cB.Text Then 
        Draw.FillStyle = 0
        Draw.Foreground = Color.Red
        If togFocus.value Then Draw.Ellipse(myBall.x - 3, myBall.y - 3, 11, 11) 
        lblX.Caption = Str(Round(myBall.x))
        lblY.Caption = Str(Round(myBall.y))
        If myball.y <= 0 Then 
          lblOutOfRange.Visible = True
        Else 
          lblOutOfRange.Visible = False
        End If
        lblaX.Caption = Str(Round(myBall.ax))
        lblaY.Caption = Str(Round(myBall.ay))
        Draw.FillStyle = 1
      End If
    Next
    Draw.End
    If cB.Text = ("ALL") Then 
      lblX.Caption = "%null%"
      lblY.Caption = "%null%"
      lblaX.Caption = "%null%"
      lblaY.Caption = "%null%"
      lblOutOfRange.Visible = False
    End If
    isDrawing = False
  End If
End

Private Sub Render()
  
  DoGravity
  If togClear.Value Then dW.Clear()
  Wait 0.001
  DrawWorld
  
End


Public Sub Form_Open()
  cb.Add(("ALL"))
End

Public Sub Button1_Click()
   AddBall  
End

Public Sub Timer1_Timer()

  Render  

End

Public Sub Form_Resize()
  Timer1.Enabled = False
  
  'DO
  '  WAIT 1
  'LOOP WHILE modGravity.isDrawing
  
  dw.Width = Me.Width - dw.Left - 10  
  dw.Height = Me.Height - dw.top - 10
  Timer1.Enabled = True  
  

End


Public Sub Slider1_Change()

   lblGrav.Caption = ("Gravity:") & " " & Str(Slider1.Value / 100)
   world_Gravity = Slider1.Value / 100

End


Public Sub togGrav_Click()

  If Not togGrav.Value Then 
    lblGrav.Caption = ("Gravity: off")
    lblSlide.Caption = ("Floor Slide: off")
    Slider1.Enabled = False
    Slider2.Enabled = False
    world_SlideFloor = 1
  Else 
    Slider1.Enabled = True
    Slider2.Enabled = True
    lblGrav.Caption = ("Gravity:") & " " & Str(Slider1.Value / 100)
    lblSlide.Caption = ("Floor Slide:") & " " & Str(Slider2.Value / 100)
    world_SlideFloor = Slider2.Value / 100
  End If

End

Public Sub cmdRandomize_Click()
  Dim myBall As CBall  
  Dim index As Integer
  cmdRandomize.Enabled = False
  Draw.begin(dW)
  Draw.FillStyle = 1
  For Each myBall In Objects
    index = index + 1
    Draw.Foreground = myBall.col
    Draw.Ellipse(myBall.x, myBall.y, 5, 5) 
    If Str(index) = cB.Text Or cB.Text = ("ALL") Then 
      myBall.ax = Rnd(1, 100)
      myBall.ay = Rnd(1, 100)
    End If
  Next
  Draw.End
  cmdRandomize.Enabled = True
End



Public Sub dW_MouseMove()
  If togAddMore.Value Then 
    AddBall(Mouse.x, Mouse.Y)  
  End If
End

Public Sub Slider2_Change()

   lblSlide.Caption = ("Floor Slide:") & " " & Str(Slider2.Value / 100)
   world_SlideFloor = Slider2.Value / 100

End


Public Sub togAddMore_Click()

  If togAddMore.Value Then 
    lbladdmore.visible = True  
  Else 
    lblAddMore.visible = False
  End If

End

Public Sub dW_MouseUp()

  togAddMore.Value = False
  lblAddMore.visible = False  

End

Public Sub lblAbout_MouseDown()

  FAbout.ShowModal  

End