Ejemplos usando el Api de windows para Visual basic

86 - Hacer un Zoom sobre un gráfico con StretchBit

Volver al Listado Api - Anterior - Siguiente

El siguiente ejemplo realiza un zoom a un Gráfico utilizando el Api StretchBit.

Nota: Agradesco algunos foreros de canal visual basic que me arreglaron un problemita que tenía al mostrar el gráfico.

El mismo permite seleccionar una porción de una imagen que se encuentra cargadada en un control PictureBox y esa porción de imagen se dibuja en otro control Picture.

Esta una muestra del ejemplo:

vista del ejemplo para hacer un zoom de un gráfico mediante el api de windows

Yo probé este ejemplo ( con varios cambios ) para ver la diferencia de velocidad de redibujado utilizando el PaintPicture y el Api StretchBit. Entre estas 2 no noté mucha diferencia, pero si se nota bastante agregando otra función api llamada SetStretchBitMode. Pero hay que aclarar que, aplicando SetStretchBitMode , la imagen se ve como difuminada o suavizada, pero va mas rápida.

En el ejemplo, como muestra el gráfico, tiene un CheckBox que indica si le aplica el SetStretchBitMode o no ( Aplicar suavizado ). La barra de Scroll determina el factor de Zoom.

Colocar Un Picture1 y cargarle un gráfico. Luego agregar un Picture2 donde se visualizará la imagen. Un control Check1 para aplicar el suavizado. Un Hscrollbar1 para el factor de Zoom y un Label1 al costado de la barra de Scroll.

Código en un Form

Option Explicit 'Funciones api StretchBlt y SetStretchBltMode para dibujar en el HDC (Picture2) 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 hStretchMode As Long) As Long Dim X0 As Long, Y0 As Long 'Para las dimensiones y posicion de la imagen Dim Lleft As Long, Ttop As Long, hHeight As Long, wWidth As Long 'Variable para el factor de Zoom Dim zoom As Byte Dim BordeWidth As Byte Private Sub Form_Load() With Picture1 If .BorderStyle = 0 Then BordeWidth = 15 Else BordeWidth = 80 End If zoom = 4 .DrawMode = vbNotXorPen .DrawStyle = vbDash End With HScroll1.Min = 1 HScroll1.Max = 10 Check1.Caption = " Aplicar suavizado a la imagen " Check1.Value = 1 End Sub Private Sub HScroll1_Change() zoom = HScroll1.Value Label1.Caption = "Factor de Zoom: " & HScroll1.Value End Sub Private Sub Picture1_MouseDown( _ Button As Integer, _ Shift As Integer, _ X As Single, Y As Single) Picture1.Cls X0 = X: Y0 = Y End Sub Private Sub Picture1_MouseMove( _ Button As Integer, _ Shift As Integer, _ X As Single, Y As Single) If Button = 1 Then 'Se borra el recuadro de Zoom y se vuelve a dibujar Picture1.Cls Picture1.Line (X0, Y0)-(X, Y), , B End If End Sub Private Sub Picture1_MouseUp( _ Button As Integer, _ Shift As Integer, _ X As Single, Y As Single) Picture1.Cls If X >= Picture1.Width Then X = Picture1.Width - BordeWidth If Y >= Picture1.Height Then Y = Picture1.Height - BordeWidth If X < 0 Then X = 0 If Y < 0 Then Y = 0 If X0 < X Then Lleft = X0 Else Lleft = X If Y0 < Y Then Ttop = Y0 Else Ttop = Y wWidth = Abs(X0 - X) hHeight = Abs(Y0 - Y) Picture2.Width = wWidth * zoom Picture2.Height = hHeight * zoom 'Para que el picutre2 tome las medidas antes de ser pintado DoEvents If Check1 Then 'SetStretchBltMode aplica un suavizado _ cuando estiramos la imagen(como si la difuminara) Call SetStretchBltMode(Picture2.hdc, 4) End If StretchBlt Picture2.hdc, 0, 0, wWidth * zoom, hHeight * zoom, _ Picture1.hdc, Lleft / Screen.TwipsPerPixelX, Ttop / _ Screen.TwipsPerPixelY, wWidth, hHeight, vbSrcCopy Picture1.Line (X0, Y0)-(X, Y), , B Picture1.DrawStyle = 0 Picture1.Line (Lleft - 90, Ttop - 90)-(Lleft - 30, Ttop - 30), 0, BF Picture1.Line (Lleft - 90, Ttop + hHeight + 30)- _ (Lleft - 30, Ttop + hHeight + 90), 0, BF Picture1.Line (Lleft + wWidth + 30, Ttop - 90)- _ (Lleft + wWidth + 90, Ttop - 30), 0, BF Picture1.Line (Lleft + wWidth + 30, Ttop + hHeight + 30)- _ (Lleft + wWidth + 90, Ttop + hHeight + 90), 0, BF Picture1.DrawStyle = 1 End Sub

vb 6.0 - Enlaces relacionados

Vb.net - Enlaces relacionados

Zoom en picturebox

Buscar en Recursos vb