Leandro Ascierto

Esta es una función que sirve para pintar una imágen de forma ampliada pero manteniendo su contorno original, para que se entienda, cuando utilizamos PaintPicture o StretchBlt en una imágen, ésta se estira proporcionalmente y en un caso como éste (imágen) el borde del botón se deformaría, en esta función debe pasarse un parámetro en el cual debe indicarse un ancho/alto en común para los bordes.

Option Explicit

' -------------------------------------------------
' Autor: Leandro Ascierto
' Web:   www.leandroascierto.com.ar
' -------------------------------------------------

Private Declare Function StretchBlt Lib "gdi32.dll" (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.dll" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GdiTransparentBlt Lib "gdi32.dll" (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 crTransparent As Long) As Boolean
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Function RenderStretchFromDC(ByVal DestDC As Long, _
                                ByVal DestX As Long, _
                                ByVal DestY As Long, _
                                ByVal DestW As Long, _
                                ByVal DestH As Long, _
                                ByVal SrcDC As Long, _
                                ByVal x As Long, _
                                ByVal y As Long, _
                                ByVal Width As Long, _
                                ByVal Height As Long, _
                                ByVal Size As Long, _
                                Optional MaskColor As Long = -1)

Dim Sx2 As Long

Sx2 = Size * 2

If MaskColor <> -1 Then
    Dim mDC         As Long
    Dim mX          As Long
    Dim mY          As Long
    Dim DC          As Long
    Dim hBmp        As Long
    Dim hOldBmp     As Long

    mDC = DestDC
    DC = GetDC(0)
    DestDC = CreateCompatibleDC(0)
    hBmp = CreateCompatibleBitmap(DC, DestW, DestH)
    hOldBmp = SelectObject(DestDC, hBmp) ' save the original BMP for later reselection
    mX = DestX: mY = DestY
    DestX = 0: DestY = 0
End If

SetStretchBltMode DestDC, vbPaletteModeNone

BitBlt DestDC, DestX, DestY, Size, Size, SrcDC, x, y, vbSrcCopy  'TOP_LEFT
StretchBlt DestDC, DestX + Size, DestY, DestW - Sx2, Size, SrcDC, x + Size, y, Width - Sx2, Size, vbSrcCopy 'TOP_CENTER
BitBlt DestDC, DestX + DestW - Size, DestY, Size, Size, SrcDC, x + Width - Size, y, vbSrcCopy 'TOP_RIGHT
StretchBlt DestDC, DestX, DestY + Size, Size, DestH - Sx2, SrcDC, x, y + Size, Size, Height - Sx2, vbSrcCopy 'MID_LEFT
StretchBlt DestDC, DestX + Size, DestY + Size, DestW - Sx2, DestH - Sx2, SrcDC, x + Size, y + Size, Width - Sx2, Height - Sx2, vbSrcCopy 'MID_CENTER
StretchBlt DestDC, DestX + DestW - Size, DestY + Size, Size, DestH - Sx2, SrcDC, x + Width - Size, y + Size, Size, Height - Sx2, vbSrcCopy 'MID_RIGHT
BitBlt DestDC, DestX, DestY + DestH - Size, Size, Size, SrcDC, x, y + Height - Size, vbSrcCopy 'BOTTOM_LEFT
StretchBlt DestDC, DestX + Size, DestY + DestH - Size, DestW - Sx2, Size, SrcDC, x + Size, y + Height - Size, Width - Sx2, Size, vbSrcCopy   'BOTTOM_CENTER
BitBlt DestDC, DestX + DestW - Size, DestY + DestH - Size, Size, Size, SrcDC, x + Width - Size, y + Height - Size, vbSrcCopy 'BOTTOM_RIGHT

If MaskColor <> -1 Then
    GdiTransparentBlt mDC, mX, mY, DestW, DestH, DestDC, 0, 0, DestW, DestH, MaskColor
    SelectObject DestDC, hOldBmp
    DeleteObject hBmp
    DeleteDC DC
    DeleteDC DestDC
End If

End Function 

Private Function RenderStretchFromPicture(ByVal DestDC As Long, _
                                ByVal DestX As Long, _
                                ByVal DestY As Long, _
                                ByVal DestW As Long, _
                                ByVal DestH As Long, _
                                ByVal SrcPicture As StdPicture, _
                                ByVal x As Long, _
                                ByVal y As Long, _
                                ByVal Width As Long, _
                                ByVal Height As Long, _
                                ByVal Size As Long, _
                                Optional MaskColor As Long = -1)

    Dim DC          As Long
    Dim hOldBmp     As Long

    DC = CreateCompatibleDC(0)
    hOldBmp = SelectObject(DC, SrcPicture.Handle)

    RenderStretchFromDC DestDC, DestX, DestY, DestW, DestH, DC, x, y, Width, Height, Size, MaskColor 

    hOldBmp = SelectObject(DC, hOldBmp)
    DeleteDC DC

End Function