Zoom en Picturebox. Tratamiento de imágenes. Parte IX.

Hoy vamos a mostrar cómo crear un zoom interactivo en un Picturebox. En la siguiente imagen se muestra el resultado del zoom.

Resultado de crear zoom interactivo

Como vemos, los controles que vamos a necesitar son, dos Picturebox (el principal y donde se mostrará el zoom) y un label (para mostrar el zoom actual).
A continuación se puede observar el código fuente del procedimiento para hacer zoom.

    'X: Coordenada X del puntero con respecto al Picturebox1
    'Y: Coordenada Y del puntero con respecto al Picturebox1
    'ValorZoom: Aumento con respecto al picturebox1
    'ValorPicturebox: Valor del lado del Picturebox2 
    'Puntero (opcional): Indica se se va a mostrar un puntero en la posición actual 
    'ColorPuntero(opcional): Color del puntero .
    'TamanoPuntero(opcional): tamaño del lado del puntero
    'EtiquetaZoom(opcional): Indica si se va a mostrar un label con el zoom actual
    Sub zoomInteractivo(ByVal x As Integer, ByVal y As Integer, ByVal valorZoom As Decimal, ByVal valorPicturebox As Size, Optional ByVal puntero As Boolean = False, Optional colorPuntero As Color = Nothing, Optional tamanoPuntero As Integer = 1, Optional etiquetaZoom As Boolean = False)

        Dim xResta, yResta As Single
        PictureBox2.Size = valorPicturebox
        valorZoom = Decimal.Round(valorZoom, 2)
        xResta = CInt((PictureBox2.Width / 2) / valorZoom)
        yResta = CInt((PictureBox2.Height / 2) / valorZoom)

        Dim bmpAux As New Bitmap(PictureBox1.Image)


        If x > 0 And y > 0 Then 'Si están en los límites del Picturebox original

            'Solucionamos problema con esquinas
            If x > bmpAux.Width - xResta Then
                x = bmpAux.Width - xResta
            End If
            If y > bmpAux.Height - yResta Then
                y = bmpAux.Height - yResta
            End If
            If x - xResta < 0 Then
                x = xResta
            End If

            If y - yResta < 0 Then
                y = yResta
            End If

            'Creamos el bitmap con el tamaño elegido
            Dim bmp As Bitmap = bmpAux.Clone(New Rectangle(New Point(x - xResta, y - yResta), New Size(xResta * 2, yResta * 2)), Imaging.PixelFormat.DontCare)
            Dim bmpSalida As New Bitmap(bmp, PictureBox2.Width, PictureBox2.Height)
            PictureBox2.Image = bmpSalida


            'Situamos el Picturebox 2
            Dim localizacion As Point
            localizacion.X = x
            localizacion.Y = y

            If x + PictureBox2.Width > PictureBox1.Width Then
                localizacion.X = x - PictureBox2.Width
            End If
            If y + PictureBox2.Height > PictureBox1.Height Then
                localizacion.Y = y - PictureBox2.Height
            End If

            If Panel1.HorizontalScroll.Value > 0 Then
                localizacion.X -= Panel1.HorizontalScroll.Value
            End If
            If Panel1.VerticalScroll.Value > 0 Then
                localizacion.Y -= Panel1.VerticalScroll.Value
            End If
            PictureBox2.Location = localizacion


            'Con esto forzamos la recolección de basura y destruimos el bitmap
            'El uso no es aconsejable pero imprescindible en este caso
            GC.Collect()
            GC.WaitForPendingFinalizers()

            'Pintamos el puntero
            If puntero = True Then
                PictureBox1.Refresh()
                PictureBox2.Refresh()
                'Si el puntero no tiene color lo ponemos rojo
                If colorPuntero = Nothing Then colorPuntero = Color.Red
                'Calculamos el lado del cuadrado
                Dim lado As Integer = tamanoPuntero * 2
                Dim Picture1 As Graphics = PictureBox1.CreateGraphics
                Picture1.DrawRectangle(New Pen(colorPuntero, 1), New Rectangle(New Point(x - tamanoPuntero, y - tamanoPuntero), New Size(lado, lado)))
                Dim Picture2 As Graphics = PictureBox2.CreateGraphics
                Picture2.DrawRectangle(New Pen(colorPuntero, 1), New Rectangle(New Point(PictureBox2.Width / 2 - tamanoPuntero, PictureBox2.Height / 2 - tamanoPuntero), New Size(lado, lado)))
            End If

            'Si mostramos el label con el zoom
            If etiquetaZoom = True Then
                Label1.Visible = True
                Label1.Text = "x" & valorZoom
                Label1.Location = New Size(PictureBox2.Location.X + PictureBox2.Width / 2 - 10, PictureBox2.Location.Y - 20)
            End If
        End If
    End Sub

El procedimiento es muy sencillo, realmente lo que hacemos, es crear un bitmap con la zona aumentada y mostrarlo en el Picturebox2. Hay que tener un poco de cuidado cuando el ratón está en las esquinas, para que no haya ningún error, pero esto lo solucionamos en la primero parte del procedimiento.
Ahora bien, ¿y cómo llamamos a la función? Pues desde el evento MouseMove del Picturebox1, pasándole la posición actual del ratón.

 Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
        'Muestra el zoom a medida que nos desplazamos por el Picturebox
        zoomInteractivo(e.X, e.Y, valZoom, New Size(100, 100), True, Color.Red, 1, True)
  End Sub

También debemos llamarlo cuando estemos encima de Picturebox2, teniendo en cuenta que debemos hacer unos cálculos previos para hallar la posición real del mouse con respecto al Picturebox1.

 Private Sub PictureBox2_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox2.MouseMove
        'Si el cursor está encima del picturebox2, calcula dónde tiene que coger el valor del Picturebox1
            zoomInteractivo(PictureBox2.Location.X + e.X + Panel1.HorizontalScroll.Value, PictureBox2.Location.Y + e.Y + Panel1.VerticalScroll.Value, valZoom, New Size(100, 100), True, Color.Red, 1, True)Color.Red, 1, True)
    End Sub

Y por último para hacer zoom vamos a aprovechar el evento del formulario MouseWheel. Este evento se activa cuando se da vueltas a la ruleta del ratón. Aquí hay que realizar también un pequeño cálculo previo para la posición x e y del ratón.

    Dim valZoom As Decimal = 1
    Private Sub Form1_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
        'Aumenta el zoom con la rueda del ratón
        If e.Delta > 0 Then
            valZoom += 0.2 'Aumentamos zoom
            zoomInteractivo(e.X + Panel1.HorizontalScroll.Value, e.Y + Panel1.VerticalScroll.Value, valZoom, New Size(100, 100), True, Color.Red, 1, True)
        ElseIf valZoom > 0.4 Then 'No puede ser menor
            valZoom -= 0.2 'Disminuimos zoom
            zoomInteractivo(e.X + Panel1.HorizontalScroll.Value, e.Y + Panel1.VerticalScroll.Value, valZoom, New Size(100, 100), True, Color.Red, 1, True)
        End If
    End Sub

Con todo esto ya tenemos nuestra función de zoom interactivo. No obstante, como hemos visto, el procedimiento tiene más argumentos que puede variar el tamaño del Picturebox2, mostrar con un tamaño y color determinado un puntero sobre la posición y etiqueta con el zoom.

Más info: http://ocw.usal.es/ensenanzas-tecnicas/herramientas-informaticas-para-el-geoprocesado

Descarga el código fuente completo: