Imprimir tickets

Un modo de generar un documento con un formato no muy complejo e imprimirlo es utilizando un formulario, añadiendole los controles deseados hasta obtener el aspecto requerido y después imprimirlo. Yo he puesto en práctica esta opción para la creación de tickets y facturas de venta.
A continuación, muestro como se realizaría esta tarea en el caso de los ticket. Para las facturas se hace de forma muy parecida, sólo hay que añadir los datos del cliente y cambiar un poco el formato.

Cuando se crea un objeto de la clase fTicket se le debe pasar una lista que incluye los artículos incluidos en la cuenta para la que se va a generar el ticket. La lista de la cuenta será una lista de objetos que contengan la información relevante de cada concepto a mostrar en el ticket.

Public Class fTicket
    Private _listaCuenta As ArrayList

    Public Sub New(ByRef cuenta As ArrayList)
        InitializeComponent()
        _listaCuenta = cuenta
    End Sub

Al mostrar el formulario se añadirán todos los controles (etiquetas, en este caso) necesariios para lograr el formato deseado. A continuación se muestra como se añadiría una línea por cada concepto en la cuenta, y posteriormente las lineas con los totales y el pie de página. La cabecera del ticket ya se ha creado en vista de diseño en el formulario ya que no cambia nunca.

    Private Sub fTicket_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
        Dim itemCuenta As ItemCuenta
        Dim i As Integer = 0
        Dim yMax As Integer, yPie As Integer

        'Para cada elemento en la lista debemos crear una línea en
        'en el ticket (añadir las etiquetas correspondientes al formulario)
        For Each o As Object In _listaCuenta
            itemCuenta = CType(o, ItemCuenta)
            'Descartamos el primer elemento porque no contiene un artículo,
            'sólo la cantidad entregada por el cliente
            If itemCuenta.nombreArticulo <> "Entregado" Then

                Dim lblDescr As Label = New Label
                lblDescr.Location = New Point(6, 134 + (i * 15))
                lblDescr.Text = itemCuenta.nombreArticulo
                lblDescr.AutoSize = False
                lblDescr.Size = New System.Drawing.Size(117, 13)
                Dim lblCantidad As Label = New Label
                lblCantidad.Location = New Point(135, 134 + (i * 15))
                lblCantidad.Text = itemCuenta.cantidadArticulo.ToString()
                lblCantidad.AutoSize = False
                lblCantidad.Size = New System.Drawing.Size(19, 13)
                lblCantidad.TextAlign = System.Drawing.ContentAlignment.MiddleRight
                Dim lblPVP As Label = New Label
                lblPVP.Location = New Point(160, 134 + (i * 15))
                lblPVP.Text = itemCuenta.precioArticulo.ToString("0.00")
                lblPVP.AutoSize = False
                lblPVP.Size = New System.Drawing.Size(45, 13)
                lblPVP.TextAlign = System.Drawing.ContentAlignment.MiddleRight
                Dim lblImporte As Label = New Label
                lblImporte.Location = New Point(211, 134 + (i * 15))
                lblImporte.Text = itemCuenta.importeArticulo.ToString("0.00")
                lblImporte.AutoSize = False
                lblImporte.Size = New System.Drawing.Size(59, 13)
                lblImporte.TextAlign = System.Drawing.ContentAlignment.MiddleRight

                Me.Controls.Add(lblDescr)
                Me.Controls.Add(lblCantidad)
                Me.Controls.Add(lblPVP)
                Me.Controls.Add(lblImporte)
                i += 1
            End If

        Next

        'Obtenemos la posición de la última línea de la cuenta para desplazar
        yMax = 134 + ((i - 1) * 15)
        yPie = yMax + 30

        'Base Imponible
        Dim lblBaseImp As Label = New Label()
        lblBaseImp.AutoSize = True
        lblBaseImp.Location = New System.Drawing.Point(117, yPie)
        lblBaseImp.Size = New System.Drawing.Size(42, 13)
        lblBaseImp.Text = "BASE IMP."
        Me.Controls.Add(lblBaseImp)

        'Obtenemos el importe total que se corresponde con el IVA
        '
        Dim lblBaseImp2 As Label = New Label()
        lblBaseImp2.AutoSize = False
        lblBaseImp2.Location = New System.Drawing.Point(117, yPie + 17)
        lblBaseImp2.Size = New System.Drawing.Size(56, 13)
        lblBaseImp2.TextAlign = System.Drawing.ContentAlignment.MiddleRight
        lblBaseImp2.Text = Utilidades.CalcularImporteTotalSinIVA(_listaCuenta).ToString("0.00")

        'Importe IVA
        Dim lblImporteIVA As Label = New Label()
        lblImporteIVA.AutoSize = True
        lblImporteIVA.Location = New System.Drawing.Point(195, yPie)
        lblImporteIVA.Size = New System.Drawing.Size(36, 13)
        lblImporteIVA.Text = "IMPORTE IVA"
        Me.Controls.Add(lblImporteIVA)

        'Obtenemos la suma del importe total de los artículos de la cuenta sin IVA
        '
        Dim lblImporteIVA2 As Label = New Label()
        lblImporteIVA2.AutoSize = False
        lblImporteIVA2.Location = New System.Drawing.Point(198, yPie + 17)
        lblImporteIVA2.Size = New System.Drawing.Size(73, 13)
        lblImporteIVA2.TextAlign = System.Drawing.ContentAlignment.MiddleRight
        lblImporteIVA2.Text = Utilidades.CalcularImporteIVA(_listaCuenta).ToString("0.00")

        '
        Me.Controls.Add(lblBaseImp2)
        Me.Controls.Add(lblImporteIVA2)

        '
        Dim lblTotalPagar As Label = New Label()
        lblTotalPagar.AutoSize = True
        lblTotalPagar.Location = New System.Drawing.Point(98, yPie + 50)
        lblTotalPagar.Size = New Size(95, 13)
        lblTotalPagar.Text = "TOTAL A PAGAR:"

        '
        Dim lblTotalPagar2 As Label = New Label()
        lblTotalPagar2.AutoSize = False
        lblTotalPagar2.Location = New System.Drawing.Point(201, yPie + 50)
        lblTotalPagar2.TextAlign = System.Drawing.ContentAlignment.MiddleRight
        lblTotalPagar2.Size = New Size(70, 13)
        lblTotalPagar2.Text = Utilidades.CalcularImporteTotalCuenta(_listaCuenta).ToString("0.00")

        '
        Me.Controls.Add(lblTotalPagar)
        Me.Controls.Add(lblTotalPagar2)

        '
        Dim lblEntregado As Label = New Label()
        lblEntregado.AutoSize = True
        lblEntregado.Location = New System.Drawing.Point(98, yPie + 72)
        lblEntregado.Size = New Size(95, 13)
        lblEntregado.Text = "ENTREGADO:"

        '
        Dim lblEntregado2 As Label = New Label()
        lblEntregado2.AutoSize = False
        lblEntregado2.Location = New System.Drawing.Point(201, yPie + 72)
        lblEntregado2.TextAlign = System.Drawing.ContentAlignment.MiddleRight
        lblEntregado2.Size = New Size(70, 13)
        lblEntregado2.Text = CType(_listaCuenta(0), ItemCuenta).precioArticulo.ToString("0.00")

        '
        Me.Controls.Add(lblEntregado)
        Me.Controls.Add(lblEntregado2)

        '
        Dim lblCambio As Label = New Label()
        lblCambio.AutoSize = True
        lblCambio.Location = New System.Drawing.Point(98, yPie + 94)
        lblCambio.Text = "CAMBIO:"

        '
        Dim lblCambio2 As Label = New Label()
        lblCambio2.AutoSize = False
        lblCambio2.Location = New System.Drawing.Point(201, yPie + 94)
        lblCambio2.TextAlign = System.Drawing.ContentAlignment.MiddleRight
        lblCambio2.Size = New Size(70, 13)
        lblCambio2.Text = (CType(_listaCuenta(0), ItemCuenta).precioArticulo - Utilidades.CalcularImporteTotalCuenta(_listaCuenta)).ToString("0.00")

        '
        Me.Controls.Add(lblCambio)
        Me.Controls.Add(lblCambio2)

        'IVA Incluido
        Dim lblIVAIncluido As Label = New Label()
        lblIVAIncluido.Location = New System.Drawing.Point(193, yPie + 118)
        lblIVAIncluido.Text = "IVA INCLUIDO"

        '
        Me.Controls.Add(lblImporteIVA)
        Me.Controls.Add(lblImporteIVA2)

        'Gracias por su visita
        Dim lblGraciasVisita As Label = New Label()
        lblGraciasVisita.AutoSize = True
        lblGraciasVisita.Location = New System.Drawing.Point(13, yPie + 145)
        lblGraciasVisita.TextAlign = System.Drawing.ContentAlignment.MiddleRight
        'lblGraciasVisita.Size = New Size(78, 13)
        lblGraciasVisita.Text = "GRACIAS POR SU VISITA"

        '
        Me.Controls.Add(lblIVAIncluido)
        Me.Controls.Add(lblGraciasVisita)

        If yPie + 170 > Me.Height Then
            Me.MinimumSize = New Size(Me.Width, yPie + 190)
        End If

        PrintDocument1.Print()
    End Sub

En el código que se muestra a continuación se puede ver como se realiza la impresión del ticket. La idea consiste en dibujar el texto contenido en las etiquetas en el evento e en la misma posición en la que se situaron dichas etiquetas dentro del formulario.
Para llevar a cabo este proceso se recorren todos los controles del formulario y se descartan todos aquellos que no sean del tipo que queremos imprimir. Los que sean del tipo que deseamos imprimir se dibujarán en el objeto e en una posición acorde a la que tienen en el formulario.

    Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e  As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage

        DibujarTicket(e.Graphics())
    End Sub





    Private Sub DibujarTicket(ByVal g As Graphics)
        ' Create the source rectangle from the BackgroundImage Bitmap Dimensions
        Dim srcRect As Rectangle = New Rectangle(0, 0, Me.Width, Me.Height)
        Dim nWidth As Integer = Me.Width       
        Dim nHeight As Integer = Me.Height
        Dim destRect As Rectangle = New Rectangle(0, 0, nWidth, CInt(Math.Ceiling(nHeight / 2)))
        Dim lbl As Label

        Dim scalex As Double = 1 * CSng(destRect.Width / srcRect.Width)
        Dim scaley As Double = 2 * CSng(destRect.Height / srcRect.Height)
        Dim aPen As New Pen(Brushes.Black, 1)
        ' Recorre todos los controles. Determina si es un label y dibuja el valor de la propiedad text
        ' en la posición correcta (en función de la propiedad location del control label en cuestión)

        For Each o As Object In Me.Controls
            If o.GetType() = Label1.GetType() Then
                lbl = CType(o, Label)
                If lbl.TextAlign = ContentAlignment.MiddleRight Then
                    g.DrawString(lbl.Text, lbl.Font, Brushes.Black, CSng((lbl.Bounds.Right - 6 * lbl.Text.Length) * scalex),
                                 CSng(lbl.Bounds.Top * scaley), New StringFormat())
                Else
                    g.DrawString(lbl.Text, lbl.Font, Brushes.Black, CSng((lbl.Bounds.Left) * scalex),
                                 CSng(lbl.Bounds.Top * scaley), New StringFormat())

                End If

            End If
        Next

        Me.Close()
    End Sub

Autentificación de usuarios

Últimamente, he estado trabajando en un pequeño proyecto y por eso no he añadido contenido al blog. Sin embargo, ahora que he terminado, he decidido crear algunas entradas aquí con cosas que creo que se utilizan muy a menudo en los proyectos de programación y que espero que sean útiles.
En esta entrada voy a mostrar el funcionamiento de un formulario de autentificación que yo he utilizado.

Public Class fAutentificacion

    Private Sub btnEntrar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEntrar.Click
        If txtUsuario.Text = "" And txtContrasena.Text = "" Then
            MessageBox.Show("Introduzca un usuario y una contraseña", "Autentificación", MessageBoxButtons.OK, MessageBoxIcon.Information)
        Else
            If txtUsuario.Text = "" Or Validacion.Usuario(txtUsuario.Text) = False Then
                MessageBox.Show("Introduzca un nombre de usuario con el formato correcto", "Autentificación", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Else
                'Comprobamos si las credenciales son correctas
                If BD.CredencialesCorrectas(txtUsuario.Text, BD.PasswordHash(txtContrasena.Text)) Then
                    'Autentificación correcta
                    Dim fGestion As fAdmin
                    'Ocultamos el formulario del TPV
                    Me.Owner.Visible = False
                    'Ocultamos el formulario de autentificación
                    Me.Hide()
                    'Abrimos el formulario al que queremos acceder
                    fGestion = New fAdmin()
                    fGestion.ShowDialog(Me.Owner)
                Else
                    'Autentificación incorrecta
                    MessageBox.Show("Autentificación incorrecta", "Autentificación", MessageBoxButtons.OKCancel, MessageBoxIcon.Error)
                End If
            End If

        End If
    End Sub


    Private Sub fAutentificacion_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
        Me.Owner.Visible = True
    End Sub

    Private Sub fAutentificacion_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        txtUsuario.Select()
    End Sub
End Class

En el código anterior se utilizan algunos métodos que yo he creado especificamente y que muestro a continuación para aclarar totalmente el funcionamiento del código.

    'Validación nombre usuario
    Public Shared Function Usuario(ByVal cadena As String) As Boolean

        If Regex.IsMatch(cadena, "^[a-zA-ZñÑ_][a-zA-ZñÑ0-9._]+$") Then
            Return True
        Else
            Return False
        End If
    End Function

El código anterior se ocupa de comprobar que el formato del nombre de usuario introducido es correcto. En este caso, sólo se admiten caracteres alfabéticos (mayúsculas y minúsculas y ñ y Ñ), numéricos y los símbolos de puntuación '.' y '_'. Además, el carácter '.' no podrá utilizarse como carácter inicial.
Para realizar la validación se utiliza una expresión regular.

    'Autentificación de las credenciales aportadas contra la base de datos
    Public Shared Function CredencialesCorrectas(ByRef usuario As String, ByRef contrasena As String) As Boolean
        Dim cadenaConexion As String
        Dim conexion As OleDbConnection
        Dim comando As OleDbCommand
        Dim resultado As Integer
        Dim consulta As String

        cadenaConexion = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Environment.CurrentDirectory & "\ficheroBD.accdb;Persist Security Info=False;"
        conexion = New OleDbConnection(cadenaConexion)
        consulta = "SELECT COUNT(*) FROM PERSONAL WHERE StrComp(Nombre,'" & usuario & "',0)=0 AND Contrasena='" & contrasena & "' AND Acceso='Administrador'"

        conexion.Open()
        comando = New OleDbCommand(consulta, conexion)
        resultado = CType(comando.ExecuteScalar(), Integer)

        conexion.Close()

        If resultado > 0 Then
            Return True
        Else
            Return False
        End If

    End Function

El código arriba mostrado realiza la comparación entre los datos aportados por el usuario y los guardados en la base de datos para el nombre de usuario indicado.

    'Obtención de la función hash SHA1 de la contraseña (para no mantener
    'las contraseñas almacenadas en texto plano)
    Public Shared Function PasswordHash(ByVal password As String) As String
        Dim bytes() As Byte = Encoding.Unicode.GetBytes(password)
        Dim inArray() As Byte = HashAlgorithm.Create("SHA1").ComputeHash(bytes)

        Return Convert.ToBase64String(inArray)
    End Function

Multimedia

Estos últimos días he estado haciendo algunas pruebas con MCI (Multimedia Control Interface), algo nuevo para mi. A pesar de algunos contratiempos iniciales, que me hicieron incluso pensar en utilizar el control Windows Media Player, al final ha merecido la pena perder un poco de tiempo peleando con el MCI. Esta interfaz permite un amplísimo control sobre archivos multimedia (sonido y audio). A continuación, muestro el código y la vista de diseño de un simple reproductor de archivos de sonido o video realizado utilizando el MCI.

Imports System.Text

Public Class Form1
    'Declaramos la función que nos permitirá utilizar los comandos de MCI
    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
       (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal _
       uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer


    Private Sub btnSelCarpeta_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSelFichero.Click
        Dim ofd As OpenFileDialog = New OpenFileDialog()
        Dim fichero As String, longitud As String = "                "
        Dim minutos As Integer, segundos As Integer

        'Obtenemos el fichero que queremos abrir (mostramos sólo archivos de video y audio)
        ofd.Filter = "Audio|*.wav;*.mp3|Video|*.avi;*.wmv;*.mpg"
        If ofd.ShowDialog() = DialogResult.OK Then
            'Establecemos el volumen por defecto
            tbVolumen.Value = 500
            fichero = Chr(34) & ofd.FileName & Chr(34)

            'Nos aseguramos de que el fichero está cerrado antes de abrirlo
            mciSendString("close miFichero", Nothing, 0, 0)
            mciSendString("open " & fichero & " type mpegvideo alias miFichero parent " & pnlPantalla.Handle.ToInt32 & " style child", Nothing, 0, 0)
            mciSendString("set miFichero time format ms", Nothing, 0, 0)

            'Obtenemos la duración de la reproducción en ms e inicializamos el control trackBar y la etiqueta con el tiempo total de reproducción
            mciSendString("status miFichero length", longitud, 128, 0)
            tPosicion.Enabled = True
            tbPosicion.Minimum = 0
            tbPosicion.Maximum = Val(longitud)
            minutos = Math.Floor(Val(longitud) / 60000)
            segundos = (Val(longitud) \ 1000) Mod 60
            lblTiempoTotal.Text = minutos.ToString & ":" & String.Format("{0:00}", segundos).Substring(0, 2)

            'Inicializamos el control de volumen y mostramos el video (si existe) en el panel correspondiente
            mciSendString("setaudio miFichero volume to " & tbVolumen.Value.ToString, Nothing, 0, 0)
            mciSendString("put miFichero window at 0 0 " & pnlPantalla.Width & " " & pnlPantalla.Height, Nothing, 0, 0)

        End If

    End Sub

    'Operaciones a realizar cuando se pulsa el botón reproducir
    Private Sub btnPlay_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPlay.Click
        'Se ajusta el volumen al valor seleccionado en el control correspondiente
        mciSendString("setaudio miFichero volume to " & tbVolumen.Value.ToString, Nothing, 0, 0)
        'Habilitamos el temporizador por si la reproducción había sido pausada antes de pulsar el botón reproducir
        tPosicion.Enabled = True
        'Se reproduce el archivo desde el inicio
        mciSendString("play miFichero from 0", Nothing, 0, 0)

    End Sub

    'Operaciones a realizar cuando se pulsa el botón salir
    Private Sub btnSalir_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSalir.Click
        'Cerramos el fichero
        mciSendString("close miFichero", Nothing, 0, 0)
        'Cerramos la aplicación
        Application.Exit()
    End Sub

    'Operaciones a realizar cuando se pulsa el botón pausar
    Private Sub btnPause_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPause.Click
        Dim longitud As String = "                ", formato As String = "                "
        Dim aCars() As Char = {"0"c}

        If tPosicion.Enabled = True Then
            'Si el fichero se está reproduciendo lo pausamos
            tPosicion.Enabled = False
            mciSendString("pause miFichero", Nothing, 0, 0)
        Else
            'Si el fichero no se está reproduciendo lo continuamos reproduciendo
            tPosicion.Enabled = True
            mciSendString("resume miFichero", Nothing, 0, 0)
        End If

    End Sub

    'Operación realizada al variar el control de volumen
    Private Sub tbVolumen_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tbVolumen.Scroll
        mciSendString("setaudio miFichero volume to " & tbVolumen.Value.ToString, Nothing, 0, 0)
    End Sub

    'Operaciones realizadas cuando se pulsa el botón parar
    Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click
        Dim returnData As String = "                "

        mciSendString("stop miFichero", Nothing, 0, 0)
        lblTiempo.Text = "00:00"
    End Sub


    'Operaciones a realizar al arrancar la aplicación
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'Establecemos el volumen por defecto
        tbVolumen.Value = 500
        'Limpiamos el valor de los tiempos
        lblTiempo.Text = ""
        lblTiempoTotal.Text = ""
    End Sub

    'Operaciones realizadas cada vez que vence el temporizador que comprueba el estado de la reproducción
    Private Sub tPosicion_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tPosicion.Tick
        Dim returnData As String = "                "
        Dim minutos As Integer, segundos As Integer

        'Obtenemos la posición actual de la reproducción y convertimos los milisegundos en minutos y segundos
        mciSendString("status miFichero position", returnData, 128, 0)
        tbPosicion.Value = Val(returnData)
        minutos = Math.Floor(Val(returnData) \ 60000)
        segundos = (Val(returnData) \ 1000) Mod 60
        'Reflejamos la posición actual (en el formato mm:ss) en la etiqueta correspondiente
        lblTiempo.Text = minutos.ToString & ":" & String.Format("{0:00}", segundos).Substring(0, 2)

    End Sub

    'Operaciones que se realizan cuando el usuario varía la posición del control trackBar que refleja la posición actual
    'de la reproducción en curso
    Private Sub tbPosicion_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tbPosicion.Scroll
        Dim posicion As Integer
        Dim returnData As String = "                "

        'Obtenemos la posición seleccionada por el usuario mediante el trackBar (en ms)
        posicion = tbPosicion.Value
        'Indicamos que se inicie la reproducción desde la posición indicada (en ms)
        mciSendString("play miFichero from " & posicion, returnData, 128, 0)
    End Sub

End Class

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

Simon dice...

Ya ha pasado algún tiempo desde la última entrada. Durante este tiempo he estado programando cosas, aunque no me parecían demasiado adecuadas para el blog (por el tamaño fundamentalmente). Hoy, tenía algún tiempo libre después de finalizar un proyecto para el curso así que decidí realizar una pequeña aplicación expresamente para este blog, para no olvidarme de él. Y lo primero que se me ocurrió ha sido un juego sobradamente conocido, "Simón dice...". Lo conocéis, ¿verdad?. Pues programarlo no es nada complicado. Yo lo hice en la plataforma .NET con Visual Basic. A continuación, podéis ver el código y el diseño del formulario con los nombres de los controles sobreescritos.

Imports System.Threading

Public Class Form1
    Dim esperarJugador As Boolean
    Dim INTERVALO_COLORES As Integer
    Private Const INTERVALO_COLORES_DEFECTO As Integer = 750
    Private Const INTERVALO_PARPADEO As Integer = 100
    Dim NUMERO_ITERACIONES As Integer = 5

    'Dim coloresPulsados As New ArrayList()
    Dim coloresCorrectos As New ArrayList()

    Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
        Dim aleatorio As New Random()
        Dim color As Integer

        coloresCorrectos.Clear()
        For i As Integer = 1 To NUMERO_ITERACIONES
            color = aleatorio.Next(1, 4)
            Select Case color
                Case 1
                    lbl1.BackColor = Drawing.Color.Brown
                    Me.Refresh()
                    Thread.Sleep(INTERVALO_PARPADEO)
                    lbl1.BackColor = Drawing.Color.Red
                    coloresCorrectos.Add(1)
                Case 2
                    lbl2.BackColor = Drawing.Color.Peru
                    Me.Refresh()
                    Thread.Sleep(INTERVALO_PARPADEO)
                    lbl2.BackColor = Drawing.Color.Orange
                    coloresCorrectos.Add(2)
                Case 3
                    lbl3.BackColor = Drawing.Color.YellowGreen
                    Me.Refresh()
                    Thread.Sleep(INTERVALO_PARPADEO)
                    lbl3.BackColor = Drawing.Color.Olive
                    coloresCorrectos.Add(3)
                Case 4
                    lbl4.BackColor = Drawing.Color.Aqua
                    Me.Refresh()
                    Thread.Sleep(INTERVALO_PARPADEO)
                    lbl4.BackColor = Drawing.Color.CadetBlue
                    coloresCorrectos.Add(4)
                Case Else
            End Select

            Me.Refresh()
            Thread.Sleep(INTERVALO_COLORES)
        Next

        'Hay que detectar los colores pulsados por el usuario a partir de este momento, y en cuanto no coincida
        'con las mostradas anteriormente se indica el error.
        esperarJugador = True

    End Sub

    'Inicializamos las variables necesarias

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        esperarJugador = False
    End Sub

    Private Sub lbl1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl1.Click
        'Es el turno del jugador
        CType(sender, Label).BackColor = Color.Brown
        Me.Refresh()
        Thread.Sleep(50)
        CType(sender, Label).BackColor = Color.Red
        Me.Refresh()

        If esperarJugador = True Then
            If CType(coloresCorrectos(0), Integer) = 1 Then
                coloresCorrectos.RemoveAt(0)
                If coloresCorrectos.Count = 0 Then
                    esperarJugador = False
                    MessageBox.Show("CONGRATULATIONS!")
                    nudNivel.Value += 1
                End If
            Else
                esperarJugador = False
                MessageBox.Show("GAME OVER!")
            End If
        End If

    End Sub

    Private Sub lbl2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl2.Click
        'Es el turno del jugador
        CType(sender, Label).BackColor = Color.Peru
        Me.Refresh()
        Thread.Sleep(50)
        CType(sender, Label).BackColor = Color.Orange
        Me.Refresh()

        If esperarJugador = True Then
            If CType(coloresCorrectos(0), Integer) = 2 Then
                coloresCorrectos.RemoveAt(0)
                If coloresCorrectos.Count = 0 Then
                    esperarJugador = False
                    MessageBox.Show("CONGRATULATIONS!")
                    nudNivel.Value += 1
                End If
            Else
                esperarJugador = False
                MessageBox.Show("GAME OVER!")
            End If
        End If
    End Sub

    Private Sub lbl3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl3.Click
        'Es el turno del jugador
        CType(sender, Label).BackColor = Color.YellowGreen
        Me.Refresh()
        Thread.Sleep(50)
        CType(sender, Label).BackColor = Color.Olive
        Me.Refresh()

        If esperarJugador = True Then
            If CType(coloresCorrectos(0), Integer) = 3 Then
                coloresCorrectos.RemoveAt(0)
                If coloresCorrectos.Count = 0 Then
                    esperarJugador = False
                    MessageBox.Show("CONGRATULATIONS!")
                    nudNivel.Value += 1
                End If
            Else
                esperarJugador = False
                MessageBox.Show("GAME OVER!")
            End If
        End If

    End Sub

    Private Sub lbl4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl4.Click
        'Es el turno del jugador
        CType(sender, Label).BackColor = Color.Aqua
        Me.Refresh()
        Thread.Sleep(50)
        CType(sender, Label).BackColor = Color.CadetBlue
        Me.Refresh()

        If esperarJugador = True Then
            If CType(coloresCorrectos(0), Integer) = 4 Then
                coloresCorrectos.RemoveAt(0)
                If coloresCorrectos.Count = 0 Then
                    esperarJugador = False
                    MessageBox.Show("CONGRATULATIONS!")
                    nudNivel.Value += 1
                End If
            Else
                esperarJugador = False
                MessageBox.Show("GAME OVER!")
            End If
        End If

    End Sub

    Private Sub nudNivel_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles nudNivel.ValueChanged
        If esperarJugador = False Then
            NUMERO_ITERACIONES = CInt(nudNivel.Value)
            INTERVALO_COLORES = INTERVALO_COLORES_DEFECTO - NUMERO_ITERACIONES * 50
        End If
    End Sub
End Class