Imports System.Collections
Public Class Form1
Private dentro As Boolean
Private rect1 As Rectangle
Private rect2 As Rectangle
Private rect3 As Rectangle
Private rect4 As Rectangle
Dim x0 As Integer, y0 As Integer
Dim listaObstaculos As ArrayList
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'Definimos el área ocupada por los obstáculos mostrados en el formulario (se corresponde con el área de los
'controles label fijos en el formulario, los de color gris)
rect2 = New Rectangle(300, 300, 50, 50)
rect3 = New Rectangle(380, 175, 15, 215)
rect4 = New Rectangle(230, 415, 200, 20)
'Cargamos los obstaculos en la lista
listaObstaculos = New ArrayList()
listaObstaculos.Add(rect2)
listaObstaculos.Add(rect3)
listaObstaculos.Add(rect4)
dentro = False
End Sub
Private Sub lbl1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles lbl1.MouseDown
'Cuando pulsamos el ratón sobre la etiqueta móvil activamos la variable que controla cuando se va a desplazar la etiqueta
'siguiendo los movimientos del ratón
dentro = True
End Sub
Private Sub lbl1_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles lbl1.MouseUp
'Desactivamos el seguimiento de los movimientos del ratón por parte de la etiqueta.
dentro = False
End Sub
Private Sub lbl1_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles lbl1.MouseMove
'Si la variable ha sido activada (el ratón fue pulsado sobre la etiqueta), la etiqueta seguirá los movimientos del ratón hasta
'que se deje de pulsar este (y la variable vuelva a tener valor false).
If dentro = True Then
'Obtenemos las coordenadas actuales del ratón (a las que hay que mover la etiqueta)
x0 = e.X + CType(sender, Label).Left
y0 = e.Y + CType(sender, Label).Top
'Obtenemos el área que cubrirá la etiqueta después de desplazarla
rect1 = New Rectangle(x0, y0, lbl1.Width, lbl1.Height)
'Si desplazando la etiqueta no se solapa con ninguno de los obstáculos, cambiamos la posición de la etiqueta a la del ratón
'Si se solapase el área ocupada por la etiqueta con algún obstáculo no se actualizaría la posición de la etiqueta
If (Rectangle.Intersect(rect1, rect2).IsEmpty = True) And (Rectangle.Intersect(rect1, rect3).IsEmpty = True) And (Rectangle.Intersect(rect1, rect4).IsEmpty = True) Then
lbl1.Top = e.Y + CType(sender, Label).Top
lbl1.Left = e.X + CType(sender, Label).Left
End If
End If
End Sub
'Este evento controla cuando se pulsa una tecla (sólo tenemos en cuenta las pulsaciones de las flechas)
Private Sub Form1_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
'Flecha arriba
If e.KeyCode = Keys.Up Then
'Obtenemos la posición que tendría la etiqueta después del desplazamiento indicado por la flecha pulsada
x0 = lbl1.Left
'Comprobamos el margen inferior
y0 = lbl1.Top - 1
If lbl1.Top > 0 Then
y0 = lbl1.Top - 1
Else
y0 = lbl1.Top
End If
'Obtenemos el área que ocuparía la etiqueta
rect1 = New Rectangle(x0, y0, lbl1.Width, lbl1.Height)
'Si no hay solape se actualiza la posición
If (lbl1.Top > 0) And Not chocaObstaculo(rect1) Then
lbl1.Top = y0
End If
End If
'Flecha abajo
If e.KeyCode = Keys.Down Then
'Obtenemos la posición que tendría la etiqueta después del desplazamiento indicado por la flecha pulsada
x0 = lbl1.Left
'Comprobamos el margen superior (la altura del formulario, con un pequeño ajuste)
If lbl1.Top + lbl1.Height + 34 < Me.Height Then
y0 = lbl1.Top + 1
Else
y0 = lbl1.Top
End If
'Obtenemos el área que ocuparía la etiqueta
rect1 = New Rectangle(x0, y0, lbl1.Width, lbl1.Height)
'Si no hay solape se actualiza la posición
If (lbl1.Top + lbl1.Height + 34 < Me.Height) And Not chocaObstaculo(rect1) Then
lbl1.Top = y0
End If
End If
'Flecha derecha
If e.KeyCode = Keys.Right Then
'Obtenemos la posición que tendría la etiqueta después del desplazamiento indicado por la flecha pulsada
y0 = lbl1.Top
'Comprobamos el margen superior (el ancho del formulario, con un pequeño ajuste)
If lbl1.Left + lbl1.Width + 8 < Me.Width Then
x0 = lbl1.Left + 1
Else
x0 = lbl1.Left
End If
'Obtenemos el área que ocuparía la etiqueta
rect1 = New Rectangle(x0, y0, lbl1.Width, lbl1.Height)
'Si no hay solape se actualiza la posición
If (lbl1.Left + lbl1.Width + 8 < Me.Width) And Not chocaObstaculo(rect1) Then
lbl1.Left = x0
End If
End If
'Flecha izquierda
If e.KeyCode = Keys.Left Then
'Obtenemos la posición que tendría la etiqueta después del desplazamiento indicado por la flecha pulsada
y0 = lbl1.Top
'Comprobamos el margen inferior
If lbl1.Left > 0 Then
x0 = lbl1.Left - 1
Else
x0 = lbl1.Left
End If
'Obtenemos el área que ocuparía la etiqueta
rect1 = New Rectangle(x0, y0, lbl1.Width, lbl1.Height)
'Si no hay solape se actualiza la posición
If (lbl1.Left > 0) And Not chocaObstaculo(rect1) Then
lbl1.Left = x0
End If
End If
End Sub
Private Function chocaObstaculo(ByVal rect As Rectangle) As Boolean
Dim obstaculo As Rectangle
'Recorremos todos los obstaculos de la lista
For Each obj As Object In listaObstaculos
obstaculo = CType(obj, Rectangle)
'Si alguno de los obstáculos se solapa con el área ocupada por nuestra etiqueta móvil, este método devolverá
'un valor
If Rectangle.Intersect(obstaculo, rect).IsEmpty = False Then
Return True
End If
Next
Return False
End Function
End Class
No hay comentarios:
Publicar un comentario