.jpg)
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