Sección de códigos , trucos y ejemplos para visual basic

182 - Centrar y ajustar imagen cargada en un Picture o formulario

Este es otro ejemplo que centra una imagen cargada ya sea en un control PictureBox o un Formulario, en forma proporcional

Agregar los siguientes controles:

Un control Picture llamado Picture1
Un control DriveListbox llamado Drive1
Un DirListBox llamado Dir1
Un FileListbox - File1

Colocarlos sin ninguna medida ya que se redimensionan mediante código en el evento Resize del formulario

vista del visualizador de imagen que muestra como centrar una imagen a escala en un pictuebox o formulario

Nota: si bien el ejemplo carga los gráficos en el Picture1, se puede utilizar la rutina Centrar_Imagen, para cargar el gráfico en un formulario, solo hay que pasar en el parámetro el objeto donde se cargará la imagen, por ejemplo para cargarla en un Form:

Centrar_Imagen(Form1, Ruta_De_La_Imagen)

Código fuente en un módulo bas

Option Explicit 'Variable para almacenar la imagen Private Pic As IPictureDisp Sub Centrar_Imagen(Objeto As Object, Path_Imagen As String) On Error GoTo ErrSub Dim Pos_x As Single 'Posición horizontal de la imagen Dim Pos_y As Single 'Posición vertical de la imagen Dim Ancho_IMG As Single 'Ancho de la imagen Dim Alto_IMG As Single 'Alto de la imagen Dim Ancho_Obj As Single 'Ancho en Pixeles del objeto contenedor Dim Alto_Obj As Single 'Alto en Pixeles del objeto contenedor Dim Old_Scale As Single 'Para lamacenar el ScaleMode del objeto Static old_Path As String If old_Path <> Path_Imagen Then Set Pic = LoadPicture(Path_Imagen) End If With Objeto .AutoRedraw = True .Cls Old_Scale = .ScaleMode .ScaleMode = vbPixels 'Pasa el ancho y alto de la imagen a Pixeles 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 ' Posición X e Y donde dibujar con PaintPicture Pos_x = (Ancho_Obj - Ancho_IMG) / 2 Pos_y = (Alto_Obj - Alto_IMG) / 2 End With 'Dibuja la imagen Objeto.PaintPicture Pic, Pos_x, Pos_y, Ancho_IMG, Alto_IMG 'Restaura el ScaleMode Objeto.ScaleMode = Old_Scale old_Path = Path_Imagen Exit Sub 'Error ErrSub: MsgBox Err.Description, vbCritical End Sub

Código fuente en el Formulario

Option Explicit Private Const Ancho_Nav As Single = 3000 Private Const Alto_Nav As Single = 3000 Private Sub File1_Click() ' Carga y Centra la imagen seleccionada del FileListBox en el Picture1 Call Centrar_Imagen(Picture1, Dir1 & "\" & File1.FileName) Me.Caption = File1.FileName End Sub Private Sub Form_Load() ' Filtro de extensiones para el FileList File1.Pattern = "*.BMP;*.JPG;*.ICO;*.GIF;*.JPEG;*.WMF" End Sub Private Sub Dir1_Change() File1 = Dir1 End Sub Private Sub Drive1_Change() Dir1 = Drive1 End Sub 'Redimensionado de los controles Private Sub Form_Resize() Dim Old_Scale As Single Old_Scale = ScaleMode ScaleMode = vbTwips If WindowState = 1 Then Exit Sub If ScaleWidth < (Screen.Width) / 5 Then Me.Width = (Screen.Width) / 5 Posicionar Exit Sub End If If ScaleHeight < Alto_Nav * 2 Then Me.Height = Alto_Nav * 2 Posicionar Exit Sub End If Posicionar ScaleMode = Old_Scale End Sub Private Sub Posicionar() On Local Error Resume Next Drive1.Move 10, 10, Ancho_Nav Dir1.Move 10, _ Drive1.Top + Drive1.Height + 10, _ Ancho_Nav, _ Alto_Nav File1.Move 10, _ Dir1.Top + Dir1.Height + 10, _ Ancho_Nav, _ ScaleHeight - Dir1.Height - Drive1.Height Picture1.Move Ancho_Nav, _ 10, _ ScaleWidth - Ancho_Nav, _ ScaleHeight If File1.FileName <> "" Then 'Vuelve a centrar la imagen en el picture Call Centrar_Imagen(Picture1, Dir1 & "\" & File1.FileName) End If End Sub

Recursos vb.net - enlaces relacionados

Thumbnail de imágenes en visual basic.net

Buscar en Recursos vb