GDI+. Hacer zoom respecto a la posición del Mouse en evento MouseWheel de un Pic

Iniciado por Harold23, 3 Julio 2017, 18:42 PM

0 Miembros y 1 Visitante están viendo este tema.

Harold23

Hola compañeto, pues déjame decirte que lo logré, ahora ando un poquito ponchado es con el tema del Pan.

Mira el código que organicé para tal fin, del zoom respecto al puntero del mouse:
Imports System.Drawing


Public Class frm_camera

    ''' <summary>
    ''' Verifica si un botón del Mouse se ha presionado dentro de un control.
    ''' </summary>
    Dim mousePress As Boolean = False
    ''' <summary>
    ''' Variable que guarda posición del Mouse en el evento Down de un control. Esto
    ''' ocurre cuando se presiona un botón del Mouse en un control.
    ''' </summary>
    Dim mouseDown_Location As PointF
    Dim TraslationX_Graphics_old As Single = 0F
    Dim TraslationY_Graphics_old As Single = 0F
    ''' <summary>
    ''' Variable para guardar el valor que debe trasladarse el Objeto Graphics en el eje X, durante el Zoom
    ''' para que siempre el foco del zoom sea de acuerdo a la posición del punntero del Mouse.
    ''' </summary>
    Dim TraslationX_Graphics As Single = 0F
    ''' <summary>
    ''' Variable para guardar el valor que debe trasladarse el Objeto Graphics en el eje Y, durante el Zoom
    ''' para que siempre el foco del zoom sea de acuerdo a la posición del punntero del Mouse.
    ''' </summary>
    Dim TraslationY_Graphics As Single = 0F
    ''' <summary>
    ''' Escala de zoom que debe aplicarse en ScaleTransform del Graphics, el cual se aciva con el evento MouseWheel.
    ''' </summary>
    Dim zoom As Single = 1.0F
    ''' <summary>
    ''' Escala del zoom inmediatamente anterior del que ahora tiene la variable zoom. Esta variable siempre se calcula
    ''' en el evento MouseWheel.
    ''' </summary>
    Dim zoom_old As Single = 1.0F
    ''' <summary>
    ''' Incremento del zoom que se realiza en el evento MouseWheel.
    ''' </summary>
    Const zoom_increment As Single = 0.1F
    ''' <summary>
    ''' Mínimo zoom que se puede aplicar a los dibujos.
    ''' </summary>
    Const zoom_min As Single = 0.1F
    ''' <summary>
    ''' Máximo zoom que se puede aplicar a los dibujos.
    ''' </summary>
    Const zoom_max As Single = 5.0F


    Private Sub transformar(canvas As Graphics)

        canvas.Clear(Color.Wheat)
        canvas.PixelOffsetMode = Drawing2D.PixelOffsetMode.Half
        canvas.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBilinear
        canvas.ScaleTransform(zoom, zoom)
        canvas.TranslateTransform(TraslationX_Graphics, TraslationY_Graphics)
        Dim pen As New Pen(Color.Red)
        pen.Width = 1 / zoom

        canvas.DrawRectangle(pen, 100, 100, 100, 50)

    End Sub

    ''' <summary>
    ''' Evento que se desencadena cuando se presiona un botón del Mouse en el Control.
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown

        'Se verifica que ha presionado el botón izquierdo del Mouse.
        If e.Button = MouseButtons.Left Then
            '
            'Se verifica que no se tiene g
            'If Not mousePress = True Then

            'mousePress = True
            '
            'Obtiene las coordenadas del puntero del Mouse cuando se presionó el Mouse.
            mouseDown_Location = e.Location
            TraslationX_Graphics_old = TraslationX_Graphics
            TraslationY_Graphics_old = TraslationY_Graphics
            'End If

            PictureBox1.Invalidate()

        End If
    End Sub

    ''' <summary>
    ''' Evento que se produce cunado el puntero del mouse se mueve por el control.
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove

        'Se verifica que ha presionado el botón izquierdo del Mouse.
        If e.Button = MouseButtons.Left Then
            '
            'Posición actual del puntero del mouse.
            Dim mousePosNow As PointF = e.Location
            'Variable para saber cuanto debe desplazarse el objeto gráfico de acuerdo a la
            'posición guardada en el evento MouseDown y la actual en este evento.
            Dim deltaX, deltaY As Single
            'Se haya los valores de desplazamiento.
            deltaX = mousePosNow.X - mouseDown_Location.X
            deltaY = mousePosNow.Y - mouseDown_Location.Y
            '
            'Se obtiene DE NUEVO el desplazamiento que debe realizarse en el Objeto Graphics, teniendo en cuenta
            'el valor pasado de dichos traslados obtenidos en el el evento MouseDown+ el nuevo delta de desplazamiento
            'teniendo en cuenta de dividir dicho valor con el valor actual del zoom.
            TraslationX_Graphics = (TraslationX_Graphics_old + (deltaX / zoom))
            TraslationX_Graphics = (TraslationY_Graphics_old + (deltaY / zoom))

            '
            'Obligo a redibujar el control.
            PictureBox1.Invalidate()

        End If

    End Sub

    Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
        '
        'Este evento ocurre cuando el puntero del Mouse se encuentra sobre el control
        'y soltó un botón del Mouse.
        '
        'Se indica que ya no se encuentra presionado el botón del Mouse.
        mousePress = False

    End Sub

    ''' <summary>
    ''' Evento que se produce cuando el Scroll del mouse se hace rodar.
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_MouseWheel(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseWheel
        '
        'Actualizo el valor del zoom actual, antes de que se calcule el nuevo en este evento.
        zoom_old = zoom

        'Verifico que el paso de la muesca del mouse se hace hacia arriba.(>zoom).
        If e.Delta > 0 Then
            '
            'Se incrementa el zoom, de acuerdo a la variable constante de la clase. Se
            'tiene en cuenta que no se sobrepase del mayor valor del zoom.
            zoom = Math.Min(zoom + zoom_increment, zoom_max)
        Else
            '
            'Para el caso de disminución del Mouse, establezco un mínimo valor para no tener
            'problemas de OverFlow. El mínimo valor del zoom
            zoom = Math.Max(zoom - zoom_increment, zoom_min)
        End If
        '
        'Se obtiene la posición actual del Mouse.
        Dim mousePosNow As Point = e.Location
        'Variables para saber el valor de los deltas entre la posición actual del mouse
        'y la ubicación de la parte superior izquierda del PictureBox.
        Dim deltaX, deltaY As Single
        deltaX = mousePosNow.X - PictureBox1.Location.X
        deltaY = mousePosNow.Y - PictureBox1.Location.Y
        'Variable que guardan el valor teniendo en cuenta el zoom inmediatamente
        'anterior de los desplazamientos que sufrió el Graphics.
        Dim oldGraphicsX As Single
        Dim oldGraphicsY As Single
        oldGraphicsX = ((deltaX / zoom_old))
        oldGraphicsY = ((deltaY / zoom_old))
        'Variable para guardar los nuevos desplazamientos que debe sufrir el Graphics,
        'para que el centro del foco del Zoom sea la ubicación actual del Mouse.
        Dim newGraphicsX As Single
        Dim newGraphicsY As Single
        newGraphicsX = ((deltaX / zoom))
        newGraphicsY = ((deltaY / zoom))
        '
        'Los nuevos valores de Traslado del objeto Graphics se obtiene.
        TraslationX_Graphics = newGraphicsX - oldGraphicsX + TraslationX_Graphics
        TraslationY_Graphics = newGraphicsY - oldGraphicsY + TraslationY_Graphics
        'Se obliga a redibujar el control.
        PictureBox1.Invalidate()

    End Sub

    Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint

        'Envío el objeto Graphics, para que dibuje teniendo en cuenta las transformaciones.
        transformar(e.Graphics)

    End Sub


¿Es la forma correcta?. De ser así, te agradecería pudieras ayudarme con hacer el Pan o mover por medio del Mouse, teniendo presionado el Button.Left.

Muchas gracias.