Programación General > Visual Basic 6.0 e inferiores

 Adaptar Imagen al PictureBox

(1/2) > >>

minostalgia:
Hola amigos es un gusto  conocer esta comunidad bueno tengo un problemilla  mi pictureBox esta de diferente tamaño y las fotos en otra quisiera que se adapte al pictureBox cualquier imagen los tamaños al del pictureBox
Me encontre este procedimiento le aplico pero le da un tamaño muy pequeño  

Sub Dibujar_Imagen(Objeto As Object, Path_Imagen As String)

On Error GoTo ErrSub

Dim Pos_x As Single
Dim Pos_y As Single
Dim Ancho_IMG As Single
Dim Alto_IMG As Single
Dim Ancho_Obj As Single
Dim Alto_Obj As Single
Dim Old_Scale As Single

    If Len(Dir(Path_Imagen)) = 0 Then Exit Sub
    Set Pic = LoadPicture(Path_Imagen)

    With Objeto
   
    .AutoRedraw = True
    .Cls
    .Picture = LoadPicture("")
   
    Old_Scale = .ScaleMode
   
    .ScaleMode = vbPixels
    Ancho_IMG = .ScaleX(Pic.Width, vbHimetric, vbPixels)
    Alto_IMG = .ScaleY(Pic.Height, vbHimetric, vbPixels)
   
    Ancho_Obj = .ScaleWidth
    Alto_Obj = .ScaleHeight
   
    If Ancho_IMG > Ancho_Obj Then
        Alto_IMG = Alto_IMG * Ancho_Obj / Ancho_IMG
        Ancho_IMG = Ancho_Obj
    End If
    If Alto_IMG > Alto_Obj Then
        Ancho_IMG = Ancho_IMG * Alto_Obj / Alto_IMG
        Alto_IMG = Alto_Obj
    End If
    Pos_x = (Ancho_Obj - Ancho_IMG) / 2
    Pos_y = (Alto_Obj - Alto_IMG) / 2
   
    End With
   

    Objeto.PaintPicture Pic, Pos_x, Pos_y, Ancho_IMG, Alto_IMG
    Set Objeto.Picture = Objeto.Image
   
    Objeto.ScaleMode = Old_Scale
   
    Exit Sub
   
'Error
ErrSub:
   
    If Err.Number = 76 Then
       Objeto.Cls
    Else
        MsgBox Err.Description, vbCritical
    End If
End Sub

quisiera saber como le podria dar el tamaño que tengo en picture  como heigth = 5280 y el width=5460 mas o menos
como le puedo modificar LOS VALORES O CUALES LE DEBO CAMBIAR para que este al tamaño que tiene mi pictureBox

Nebire:
Un modo sencillo  de utilizar imágenes es utilizar un control image con la propiedad strecht establecida a true. Ahora cuando cambies una medida, la imagen se rescala automáticamente para ajustarse al control.

Claro que un control no es un contenedor, por lo que si el control ha de contener otros controles, entonces sería mejor que metieras el control image dentro del picturebox.

Si a pesar de todo quieres utilizar un picturebox, la solución pasa por usar el método paintpicture.
Carga la imagen en un picturebox oculto (invisible) que tiene la propiedad border a 0 y la propiedad autosize a true, ahora sólo tienes que hacer 2 cosas...
1 hacer el tamaño del picturebox de destino de las medidas que quieres.
2 pegar en el picturebox de destino la imagen del picturebox de origen
El picturebox de destino debe tener establecida la propiedad autoredraw a true.

Todos estos valores los estbalecemos en la carga del formulario y como es para probar, ya precargamos una imagen...

--- Código: Visual Basic --- Private Sub Form_Load()    Dim ruta As String    PicOculto.BackColor = vbWhite  ' para distinguirlo del fondo del formulario si quieres probar sin hacerlo invisible.    PicOculto.Visible = False      ' lo ocultamos  de la vista del usuario    PicOculto.BorderStyle = 0      ' sin borde 3d    PicOculto.AutoSize = True      ' garantiza que cuando se cargue una imagen el control se ajuste al tamaño de la misma.        ruta = Environ$("windir") & "WebWallpaper"    ruta = ruta & Dir(ruta)    PicOculto.Picture = LoadPicture(ruta)        PicDestino.Move 0, 0          ' lo movemos a la esquina superior izquierda    PicDestino.AutoRedraw = True   ' lo que peguemos se quedará permanente.End Sub  
Necesitamos saber la cantidad de twips por píxel de la resolución actual, esto lo pdedimos por ejemplo durante el resize del formulario... al menos ocurre 1 vez ( cuando se construye el formulario).

--- Código: Visual Basic --- Dim stpx As Single  ' se contienen en estas variablesDim stpY As Single  Private Sub Form_Resize()    stpx = Screen.TwipsPerPixelX    stpY = Screen.TwipsPerPixelYEnd Sub  
Finalmente con un botón realizamos la acción deseada... fíjate que le damos 500 píxeles de ancho y alto, a la función debe pasársele el valor deseado

--- Código: Visual Basic --- ' mostramos 3 cambios de tamaño con pausas de 3 segundos entre ellasPrivate Sub Command1_Click()    Call EscalarImagen(500, 500)    Call Pausa(3)    Call EscalarImagen(640, 480)    Call Pausa(3)    Call EscalarImagen(1024, 768) End Sub Private Sub EscalarImagen(ByVal Ancho As Long, ByVal Alto As Long)    With PicDestino        Call .Move(.Left, .Top, Ancho * stpx, Alto * stpY) ' cambiamos el tamaño al deseado        Call .PaintPicture(PicOculto.Picture, 0, 0, Ancho * stpx, Alto * stpY, 0, 0, PicOculto.Width, PicOculto.Height, vbSrcCopy) ' pegamos la imagen con el tamaño deseado.    End With    Me.Caption = CStr(Ancho) & " x " & CStr(Alto) ' ponemos en el título de la ventana el tamaño actual de la imagenEnd Sub ' hacemos una pausa antes de seguir...Private Sub Pausa(ByVal Segundos As Byte)    Dim tim As Single        tim = Timer    Do        DoEvents    Loop While Timer - tim < SegundosEnd Sub  

minostalgia:
Este es el codigo fuente para que lo veas y haber si o podes redimencionar

Nebire:
Lo he descargado, mañana te lo miró en un momento, que se me hace ya muy tarde.... Sólo te pondré el código que se necesite cambiar...

minostalgia:
Muchas gracias sos un garn CHE y gran cuate amigo

Navegación

[0] Índice de Mensajes

[#] Página Siguiente