BOLAS MOVILES CON CHOQUES ELÁSTICOS.

Creamos una aplicación que dibuja dos bolas de colores diferentes que podemos modificar su posición en tiempo de ejecución y que se mueven solas. Y controlamos la distancia entre ellas para que choquen rebotando elásticamente.

el código de la aplicación es el siguiente:

Dim posx As Double

Dim posy As Double

Dim dirx As Double

Dim diry As Double

Dim posx2 As Double

Dim posy2 As Double

Dim dirx2 As Double

Dim diry2 As Double

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

posx = Shape1.Left

posy = Shape1.Top

Select Case KeyCode

Case 37

If Shift = 1 Then posx = posx - 100: dirx = -100

If Shift = 2 Then posx2 = posx2 - 100: dirx2 = -100

Case 38

If Shift = 1 Then posy = posy - 100: diry = -100

If Shift = 2 Then posy2 = posy2 - 100: diry2 = -100

Case 39

If Shift = 1 Then posx = posx + 100: dirx = 100

If Shift = 2 Then posx2 = posx2 + 100: dirx2 = 100

Case 40

If Shift = 1 Then posy = posy + 100: diry = 100

If Shift = 2 Then posy2 = posy2 + 100: diry2 = 100

Case 13

Timer1.Enabled = True

Case 27

Timer1.Enabled = False

Case 107

If Timer1.Interval < 6 Then Timer1.Interval = 6

Timer1.Interval = Timer1.Interval - 5

Case 109

Timer1.Interval = Timer1.Interval + 5

End Select

Shape1.Left = posx

Shape1.Top = posy

Shape2.Left = posx2

Shape2.Top = posy2

If Shape1.Left < 0 Then Shape1.Left = 0

If Shape1.Left > (Screen.Width - Shape1.Width) Then Shape1.Left = (Screen.Width - Shape1.Width)

If Shape1.Top < 0 Then Shape1.Top = 0

If Shape1.Top > (Screen.Height - Shape1.Height) Then Shape1.Top = (Screen.Height - Shape1.Height)

End Sub

Private Sub Form_Load()

posx = (form1.Width - Shape1.Width) / 2

posy = form1.Height / 2 - Shape1.Height * 3 / 4

dirx = 0

diry = 0

Shape1.Left = posx

Shape1.Top = posy

posx2 = form1.Width / 2

posy2 = form1.Height / 2 - Shape1.Height * 3 / 4

dirx2 = 0

diry2 = 0

Shape2.Left = posx2

Shape2.Top = posy2

End Sub

Private Sub Form_Resize()

posx = (form1.Width - Shape1.Width) / 2

posy = form1.Height / 2 - Shape1.Height * 3 / 4

dirx = 0

diry = 0

Shape1.Left = posx

Shape1.Top = posy

posx2 = (form1.Width - Shape1.Width) / 2.3

posy2 = form1.Height / 2 - Shape1.Height * 3 / 4

dirx = 0

diry = 0

Shape2.Left = posx2

Shape2.Top = posy2

End Sub

Private Sub Timer1_Timer()

Dim d As Double

d = Sqr((Shape1.Left - Shape2.Left) * (Shape1.Left - Shape2.Left) + (Shape1.Top - Shape2.Top) * (Shape1.Top - Shape2.Top))

If d < Shape1.Width Then

Dim tdirx As Double

Dim tdiry As Double

tdirx = dirx

tdiry = diry

dirx = dirx2

diry = diry2

dirx2 = tdirx

diry2 = tdiry

End If

posx = posx + dirx

posy = posy + diry

If posx < 0 Then dirx = -dirx

If posx > (form1.Width - Shape1.Width) Then dirx = -dirx

If posy < 0 Then diry = -diry

If posy > (form1.Height - Shape1.Height) Then diry = -diry

Shape1.Left = posx

Shape1.Top = posy

posx2 = posx2 + dirx2

posy2 = posy2 + diry2

If posx2 < 0 Then dirx2 = -dirx2

If posx2 > (form1.Width - Shape2.Width) Then dirx2 = -dirx2

If posy2 < 0 Then diry2 = -diry2

If posy2 > (form1.Height - Shape2.Height) Then diry2 = -diry2

Shape2.Left = posx2

Shape2.Top = posy2

End Sub