miércoles, 19 de octubre de 2011

Movimiento

En este ejemplo he decidido mostrar como se pueden utilizar algunos eventos del ratón y del teclado para mover objetos en el formulario. Es una aplicación muy sencilla, y espero que resulte igualmente instructiva. Utilizando únicamente estos eventos se pueden realizar cosas bastante llamativas. También utilizo el objeto Rectangle para controlar el área que ocupan los objetos y saber en todo momento si se solapan entre ellos.


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