SoloCodigo

Programación General => Visual Basic 6.0 e inferiores => Mensaje iniciado por: minostalgia en Viernes 11 de Junio de 2010, 04:36

Título: Adaptar Imagen al PictureBox
Publicado por: minostalgia en Viernes 11 de Junio de 2010, 04:36
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
Título: Re: Adaptar Imagen al PictureBox
Publicado por: Nebire en Lunes 14 de Junio de 2010, 14:58
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
  1.  
  2. Private Sub Form_Load()
  3.     Dim ruta As String
  4.     PicOculto.BackColor = vbWhite  ' para distinguirlo del fondo del formulario si quieres probar sin hacerlo invisible.
  5.     PicOculto.Visible = False      ' lo ocultamos  de la vista del usuario
  6.     PicOculto.BorderStyle = 0      ' sin borde 3d
  7.     PicOculto.AutoSize = True      ' garantiza que cuando se cargue una imagen el control se ajuste al tamaño de la misma.
  8.    
  9.     ruta = Environ$("windir") & "WebWallpaper"
  10.     ruta = ruta & Dir(ruta)
  11.     PicOculto.Picture = LoadPicture(ruta)
  12.    
  13.     PicDestino.Move 0, 0          ' lo movemos a la esquina superior izquierda
  14.     PicDestino.AutoRedraw = True   ' lo que peguemos se quedará permanente.
  15. End Sub
  16.  
  17.  

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
  1.  
  2. Dim stpx As Single  ' se contienen en estas variables
  3. Dim stpY As Single
  4.  
  5.  
  6. Private Sub Form_Resize()
  7.     stpx = Screen.TwipsPerPixelX
  8.     stpY = Screen.TwipsPerPixelY
  9. End Sub
  10.  
  11.  

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
  1.  
  2. ' mostramos 3 cambios de tamaño con pausas de 3 segundos entre ellas
  3. Private Sub Command1_Click()
  4.     Call EscalarImagen(500, 500)
  5.     Call Pausa(3)
  6.     Call EscalarImagen(640, 480)
  7.     Call Pausa(3)
  8.     Call EscalarImagen(1024, 768)
  9.  End Sub
  10.  
  11. Private Sub EscalarImagen(ByVal Ancho As Long, ByVal Alto As Long)
  12.     With PicDestino
  13.         Call .Move(.Left, .Top, Ancho * stpx, Alto * stpY) ' cambiamos el tamaño al deseado
  14.         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.
  15.     End With
  16.     Me.Caption = CStr(Ancho) & " x " & CStr(Alto) ' ponemos en el título de la ventana el tamaño actual de la imagen
  17. End Sub
  18.  
  19. ' hacemos una pausa antes de seguir...
  20. Private Sub Pausa(ByVal Segundos As Byte)
  21.     Dim tim As Single
  22.    
  23.     tim = Timer
  24.     Do
  25.         DoEvents
  26.     Loop While Timer - tim < Segundos
  27. End Sub
  28.  
  29.  
Título: Re: Adaptar Imagen al PictureBox
Publicado por: minostalgia en Miércoles 16 de Junio de 2010, 04:00
Este es el codigo fuente para que lo veas y haber si o podes redimencionar
Título: Re: Adaptar Imagen al PictureBox
Publicado por: Nebire en Miércoles 16 de Junio de 2010, 04:43
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...
Título: Re: Adaptar Imagen al PictureBox
Publicado por: minostalgia en Miércoles 16 de Junio de 2010, 04:45
Muchas gracias sos un garn CHE y gran cuate amigo
Título: Re: Adaptar Imagen al PictureBox
Publicado por: Nebire en Jueves 17 de Junio de 2010, 19:10
Llevaba alrededor de 1 hora escribiendo y explicando los cambios, pero al darle a enviar se ha ido todo al garete y me da pereza rescribirlo todo de nuevo, así que sólo te mando el proyecto con los cambios operados.... y si algo no lo entiendes preguntas, así será más breve...

2 cosas no obstante que si debo aclararte, la función dibujarimagen remplaza en uso a tu rutina Dibujar_Imagen (que se ha comentado),  y he añadido una función para poder especificar al guardar una imagen con la extensión de la misma, esto afecta seguramente afecte a otras funciones que pretendan utilizar la imagen guardada, como por ejemplo una función que pretenda borrar la imagen del disco, por lo que dichas situaciones deben localizar la imagen usando la función al respecto y puede usarse como ejemplo el código de llamada cuando se trata de 'guardar a disco la imagen'.
Título: Re: Adaptar Imagen al PictureBox
Publicado por: minostalgia en Viernes 18 de Junio de 2010, 04:46
Muchas gracias por tu Gracias por tu pronta respuesta lo revisare y te cuento como me fue Muchas gracias en verdad enternamente agradecido.