Leandro Ascierto

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