Hola q tal amigos de este foro, bueno tengo un pequeño problema con el manejo de imagenes en vb, lo que quiero hacer es que mediante un picture box cargar una imagen pero es muy grande asi que quisiera redimensionarla para poder enviarla por correo.
Aca esta el codigo espero y te agrade
Dim ImagenFoto As IPictureDisp
Public Function CargarRedimencionarIMG(sRuta As String, _
PictureFix As PictureBox, _
Optional ByVal Pic_Ancho As Double, _
Optional ByVal Pic_Alto As Double, _
Optional ByVal X As Integer = 0, _
Optional ByVal Y As Integer = 0, _
Optional ByVal X2 = 0, _
Optional ByVal Y2 = 0, _
Optional ByVal Ancho2, _
Optional ByVal Alto2, _
Optional Opcional) As Long
On Error GoTo Nel:
Dim Ancho As Single, Alto As Single, Porcentaje As Single
Pic_Ancho = IIf(Pic_Ancho <= 0, PictureFix.Width, Pic_Ancho)
Pic_Alto = IIf(Pic_Alto <= 0, PictureFix.Height, Pic_Alto)
PictureFix.Width = Val(Pic_Ancho): PictureFix.Height = Val(Pic_Alto)
PictureFix.Cls
Set ImagenFoto = LoadPicture(sRuta)
Ancho = ImagenFoto.Width
Alto = ImagenFoto.Height
If Ancho < PictureFix.Width And Alto < PictureFix.Height Then
Porcentaje = 100
CargarRedimencionarIMG = CentrarPicture(PictureFix, Ancho, Alto, X, Y, Porcentaje, X2, Y2, Ancho2, Alto2, Opcional)
Exit Function
End If
If Ancho > PictureFix.Width Or Alto > PictureFix.Height Then
If Ancho > Alto Then
Porcentaje = (PictureFix.Width * 100) / Ancho
Else
Porcentaje = (PictureFix.Height * 100) / Alto
End If
CargarRedimencionarIMG = CentrarPicture(PictureFix, Ancho, Alto, X, Y, Porcentaje, X2, Y2, Ancho2, Alto2, Opcional)
Exit Function
ElseIf Ancho <= PictureFix.Width Or Alto <= PictureFix.Height Then
If Ancho > Alto Then
Porcentaje = (PictureFix.Width * 100) / Ancho
Else
Porcentaje = (PictureFix.Width * 100) / Alto
End If
CargarRedimencionarIMG = CentrarPicture(PictureFix, Ancho, Alto, X, Y, Porcentaje, X2, Y2, Ancho2, Alto2, Opcional)
End If
Exit Function
Nel:
Cargar = 0
Err.Clear
End Function
Private Function CentrarPicture(PictureFix As PictureBox, _
Optional ByVal Ancho As Double, _
Optional ByVal Alto As Double, _
Optional ByVal X As Integer = 0, _
Optional ByVal Y As Integer = 0, _
Optional Porcentaje As Single = 100, _
Optional ByVal X2 As Integer = 0, _
Optional ByVal Y2 As Integer = 0, _
Optional ByVal Ancho2, _
Optional ByVal Alto2, _
Optional Opcional) As Long
On Error GoTo Nel
Ancho = (Ancho * Porcentaje) / 100
Alto = (Alto * Porcentaje) / 100
PictureFix.Width = Ancho
PictureFix.Height = Alto
PictureFix.PaintPicture ImagenFoto, X, Y, Ancho, Alto, X2, Y2, Ancho2, Alto2, Opcional
CentrarPicture = 1
Exit Function
Nel:
CentrarPicture = 0
Err.Clear
End Function
Hola,yo creo que con un PaintPicture te alcanza...
saludos.
Cita de: seba123neo en 20 Septiembre 2008, 04:51 AM
Hola,yo creo que con un PaintPicture te alcanza...
saludos.
lo mismo digo, aun que la funcion que puse detecta escala la imagen a el picture y lo ajusta a este sin importar el tamaño de la imagen a cargar y no distorciona la imagen en cuestion de anchura y altura je (probarlo para verlo mejor)
r=cargarredimencionarimg("c:\img.jpg",picture1)
ok gracias, lo probare.