Foro de elhacker.net

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.

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.