Igual que la función superior esta sirve para pintar una imágen de forma ampliada pero manteniendo su contorno original utilizando GDI PLUS, esto nos da como ventaja poder utilizar gráficos .PNG entre otros. Nótese que si ponemos el form con AutoRedraw = True la función trabaja más rápido.
Option Explicit
' ----------------------------------------
' Autor Leandro Ascierto
' Web www.leandroascierto.com.ar
' ----------------------------------------
Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, ByVal srcUnit As Long, Optional ByVal imageAttributes As Long = 0, Optional ByVal Callback As Long = 0, Optional ByVal CallbackData As Long = 0) As Long
Private Declare Function GdipSetInterpolationMode Lib "gdiplus" (ByVal graphics As Long, ByVal InterpolationMode As Long) As Long
Private Declare Function GdipSetPixelOffsetMode Lib "gdiplus" (ByVal graphics As Long, ByVal PixelOffsetMode As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, ByRef image As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Type GDIPlusStartupInput
GdiPlusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Const GdiPlusVersion As Long = 1&
Private Const QualityModeHigh As Long = 2&
Private Const InterpolationModeNearestNeighbor As Long = QualityModeHigh + 3
Private Const PixelOffsetModeHalf As Long = QualityModeHigh + 2
Dim GdipToken As Long
Dim m_hImage As Long
Private Sub RenderStretchPlus(ByVal DestHdc As Long, _
ByVal DestX As Long, _
ByVal DestY As Long, _
ByVal DestW As Long, _
ByVal DestH As Long, _
ByVal hImage As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal Width As Long, _
ByVal Height As Long, _
ByVal Size As Long)
Dim hGraphics As Long
Dim Sx2 As Long
Sx2 = Size * 2
If GdipCreateFromHDC(DestHdc, hGraphics) = 0 Then
Call GdipSetInterpolationMode(hGraphics, InterpolationModeNearestNeighbor)
Call GdipSetPixelOffsetMode(hGraphics, PixelOffsetModeHalf)
GdipDrawImageRectRectI hGraphics, hImage, DestX, DestY, Size, Size, x, y, Size, Size, &H2, 0&, 0&, 0& 'TOP_LEFT
GdipDrawImageRectRectI hGraphics, hImage, DestX + Size, DestY, DestW - Sx2, Size, x + Size, y, Width - Sx2, Size, &H2, 0&, 0&, 0& 'TOP_CENTER
GdipDrawImageRectRectI hGraphics, hImage, DestX + DestW - Size, DestY, Size, Size, x + Width - Size, y, Size, Size, &H2, 0&, 0&, 0& 'TOP_RIGHT
GdipDrawImageRectRectI hGraphics, hImage, DestX, DestY + Size, Size, DestH - Sx2, x, y + Size, Size, Height - Sx2, &H2, 0&, 0&, 0& 'MID_LEFT
GdipDrawImageRectRectI hGraphics, hImage, DestX + Size, DestY + Size, DestW - Sx2, DestH - Sx2, x + Size, y + Size, Width - Sx2, Height - Sx2, &H2, 0&, 0&, 0& 'MID_CENTER
GdipDrawImageRectRectI hGraphics, hImage, DestX + DestW - Size, DestY + Size, Size, DestH - Sx2, x + Width - Size, y + Size, Size, Height - Sx2, &H2, 0&, 0&, 0& 'MID_RIGHT
GdipDrawImageRectRectI hGraphics, hImage, DestX, DestY + DestH - Size, Size, Size, x, y + Height - Size, Size, Size, &H2, 0&, 0&, 0& 'BOTTOM_LEFT
GdipDrawImageRectRectI hGraphics, hImage, DestX + Size, DestY + DestH - Size, DestW - Sx2, Size, x + Size, y + Height - Size, Width - Sx2, Size, &H2, 0&, 0&, 0& 'BOTTOM_CENTER
GdipDrawImageRectRectI hGraphics, hImage, DestX + DestW - Size, DestY + DestH - Size, Size, Size, x + Width - Size, y + Height - Size, Size, Size, &H2, 0&, 0&, 0& 'BOTTOM_RIGHT
Call GdipDeleteGraphics(hGraphics)
End If
End Sub
Private Sub RenderPlusFromFile(ByVal DestHdc As Long, _
ByVal DestX As Long, _
ByVal DestY As Long, _
ByVal DestW As Long, _
ByVal DestH As Long, _
ByVal FileName As String, _
ByVal x As Long, _
ByVal y As Long, _
ByVal Width As Long, _
ByVal Height As Long, _
ByVal Size As Long)
Dim hImg As Long
Call GdipLoadImageFromFile(StrPtr(FileName), hImg)
Call RenderStretchPlus(DestHdc, DestX, DestY, DestW, DestH, hImg, x, y, Width, Height, Size)
Call GdipDisposeImage(hImg)
End Sub
Private Sub InitGDI()
Dim GdipStartupInput As GDIPlusStartupInput
GdipStartupInput.GdiPlusVersion = GdiPlusVersion
Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Sub
Private Sub TerminateGDI()
Call GdiplusShutdown(GdipToken)
End Sub
Private Sub Command1_Click()
Cls
RenderPlusFromFile Me.hdc, 5, 5, 230, 230, App.Path & "\Image2.png", 0, 0, 158, 93, 26
End Sub
Private Sub Form_Load()
Call InitGDI
Call GdipLoadImageFromFile(StrPtr(App.Path & "\BotonesVista.png"), m_hImage)
Me.AutoRedraw = True 'Utilizando GDIPlus + AutoRedraw = True, es mas rapido
End Sub
Private Sub Form_Terminate()
Call GdipDisposeImage(m_hImage)
Call TerminateGDI
End Sub
Private Sub Option1_Click(Index As Integer)
Cls
RenderStretchPlus Me.hdc, 10, 10, 120, 80, m_hImage, 0, 21 * Index, 11, 21, 3
End Sub
