Ajustar Imagen en Visual Basic 6.0.

imagen principal Fecha de publicación: 06/11/2014

Función en visual Basic 6.0. para ajustar una imagen en un picturebox sin que esta se deforme conservando su proporcionalidad.

La función se llama escalar_imagen y sólo le tenemos que introducir la imagen y el picturebox donde se mostrará la imagen

Public Sub Escalar_Imagen(Img1 As StdPicture, Destino As PictureBox)
    Dim xi As Single, yi As Single, PX As Single, PY As Single
    Dim Ancho_Definitivo As Single, Alto_Definitivo As Single
    If Img1 <> 0 Then
        Destino.Cls
        xi = Destino.ScaleX(Img1.Width, vbHimetric, vbTwips)
        yi = Destino.ScaleY(Img1.Height, vbHimetric, vbTwips)
        Reescalar xi, yi, Destino.Width, Destino.Height, Ancho_Definitivo, Alto_Definitivo
        PX = (Destino.Width - Ancho_Definitivo) / 2
        PY = (Destino.Height - Alto_Definitivo) / 2
        Destino.PaintPicture Img1, PX, PY, Ancho_Definitivo, Alto_Definitivo
    End If
End Sub

Private Sub Reescalar(ByRef Ancho_Imagen As Single, ByRef Alto_Imagen As Single, ByRef Ancho_Destino As Single, ByRef Alto_Destino As Single, ByRef Ancho_Definitivo, ByRef Alto_Definitivo)
    Dim xi As Single, yi As Single, xd As Single, yd As Single, z As Single
    xi = Ancho_Imagen
    yi = Alto_Imagen
    xd = Ancho_Destino
    yd = Alto_Destino
    If xi <= xd And yi <= yd Then
        Ancho_Definitivo = xi
        Alto_Definitivo = yi
        Exit Sub
    ElseIf xi <= xd And yi > yd Then
        z = yi - yd
        Determinar_PorcentajeY yi, xi, z
        Reescalar xi, yi, Ancho_Destino, Alto_Destino, Ancho_Definitivo, Alto_Definitivo
    ElseIf xi > xd And yi <= yd Then
        z = xi - xd
        Determinar_PorcentajeX xi, yi, z
        Reescalar xi, yi, Ancho_Destino, Alto_Destino, Ancho_Definitivo, Alto_Definitivo
    ElseIf xi > xd And yi > yd Then
        If xi >= yi Then
            z = xi - xd
            Determinar_PorcentajeX xi, yi, z
            Reescalar xi, yi, Ancho_Destino, Alto_Destino, Ancho_Definitivo, Alto_Definitivo
        Else
            z = yi - yd
            Determinar_PorcentajeY yi, xi, z
            Reescalar xi, yi, Ancho_Destino, Alto_Destino, Ancho_Definitivo, Alto_Definitivo
        End If
    Else
        Ancho_Definitivo = xi
        Alto_Definitivo = yi
    End If
End Sub

Private Sub Determinar_PorcentajeY(yi As Single, xi As Single, ReducciónY As Single)
    Dim z As Single
    If yi > 0 Then
        z = (100 * xi) / yi
    Else
        z = 0
    End If
    yi = yi - ReducciónY
    xi = (z * yi) / 100
End Sub

Private Sub Determinar_PorcentajeX(xi As Single, yi As Single, ReducciónX As Single)
    Dim z As Single
    If xi > 0 Then
        z = (100 * yi) / xi
    Else
        z = 0
    End If
    xi = xi - ReducciónX
    yi = (z * xi) / 100
End Sub

Si te gusta este artículo compártelo en las redes sociales

Comentarios

No se han publicado comentarios

Publicar un comentario

Introduzca un comentario

Nombre:
Comentario:
Introduce los números
de la imagen de arriba
Introducir

Si te gusta o te es útil esta página puedes hacer una donación para permitir su mantenimiento