Ejemplos usando el Api de windows para Visual basic

61 - Api StretchBlt para ampliar, reducir y copiar imágenes - mejor que PaintPicture

Volver al Listado Api - Anterior - Siguiente

Contenido

Ejemplo 1
Ejemplo 2
Enlaces relacionados

Ejemplo 1

Este ejemplo me lo envió Leandro Ascierto, y muestra como ajustar una imagen en un control picturebox

Esta Api, en comparación a la función PaintPicture de visual basic, no distorsiona tanto la imagen , si queremos por ejemplo ampliarla. Por lo que me comentó, en el ejemplo que está aquí , tubo que utilizar el la función PaintPicture para los archivos de iconos ya que aparentemente no los soporta, pero con los demás formatos gráficos que admite vb funciona bien.

Para el ejemplo colocar un control Picture1, un Command y un CommonDialog

vista del gráfico dibujado con StretchBlt en el control Picturebox

Código fuente en un formulario:

Option Explicit ' Declaración de funciones Api Private Declare Function StretchBlt _ Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hSrcDC As Long, _ ByVal xSrc As Long, _ ByVal ySrc As Long, _ ByVal nSrcWidth As Long, _ ByVal nSrcHeight As Long, _ ByVal dwRop As Long) As Long Private Declare Function SetStretchBltMode _ Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal nStretchMode As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function SelectObject _ Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long 'Abre el cuadro de diálogo para seleccionar imagen Private Sub Command1_Click() CommonDialog1.ShowOpen ScaleImage LoadPicture(CommonDialog1.FileName), Picture1 End Sub 'Función que dibuja el archivo grafico seleccionado, en el control Picture1 Public Function ScaleImage(Img As StdPicture, Pic As Object) Dim PLeft As Long, PTop As Long Dim ReqWidth As Long, ReqHeight As Long Dim HScale As Double, VScale As Double Dim MyScale As Double Dim ImgWidth As Long Dim ImgHeight As Long Dim SourceHDC As Long 'Escala en pixles y Autoredraw para el Picturebox Pic.ScaleMode = vbPixels Pic.AutoRedraw = True 'Limpia la imagen Pic.Cls ' Convierte el valor de Himetric a pixeles ImgWidth = Me.ScaleX(Img.Width, vbHimetric, vbPixels) ImgHeight = Me.ScaleY(Img.Height, vbHimetric, vbPixels) ' Escala horizontal y vertical HScale = Pic.ScaleWidth / ImgWidth VScale = Pic.ScaleHeight / ImgHeight MyScale = IIf(VScale >= HScale, HScale, VScale) ReqWidth = ImgWidth * MyScale ReqHeight = ImgHeight * MyScale 'Posición izquierda y Arriba, para centra el gráfico: valores x y PLeft = (Pic.ScaleWidth - ReqWidth) / 2 PTop = (Pic.ScaleHeight - ReqHeight) / 2 SourceHDC = CreateCompatibleDC(0) DeleteObject SelectObject(SourceHDC, Img.Handle) SetStretchBltMode Pic.hdc, vbPaletteModeNone ' Si es un ícono usa PaintPicture, si no StretchBlt If Img.Type = 3 Then Pic.PaintPicture Img, PLeft, PTop, ReqWidth, ReqHeight Else 'Copia el gráfico en el PictureBox StretchBlt Pic.hdc, PLeft, PTop, ReqWidth, ReqHeight, _ SourceHDC, 0, 0, ImgWidth, ImgHeight, vbSrcCopy 'Libera el dispositivo DeleteDC SourceHDC End If End Function

Ejemplo 2

Este es otro ejemplo que hice está basado en el ejemplo anterior de Leandro Ascierto , pero en este caso para usarlo con formularios, y poder colocar un backGround como imagen de fondo, y que al redimensionarla, se redibuje en forma proporcional al área del mismo , también usando la función del api de windows StretchBLT

Para usarlo es muy fácil y lo único que se debe hacer es indicar la ruta física de la imagen, el formulario que se usará , y también opcionalmente un margen.

Descargar

Recursos VB.NET - Relacionados

Vista previa de imágenes tipo thumbnail en un control picture

Recursos VB 6.0 - Relacionados

Buscar en Recursos vb