FillRectEx

Función para rellenar un rectángulo en un hdc con parte o el total de otro hdc, la función es muy rápida en dibujar.

Option Explicit
' --------------------------------
' Autor Leandro Ascierto
' --------------------------------
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (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 SetBrushOrgEx Lib "gdi32.dll" (ByVal hdc As Long, ByVal nXOrg As Long, ByVal nYOrg As Long, ByRef lppt As POINTAPI) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

' Función que rellena un hdc con el contenido de otro en forma repetitiva
Private Sub FillRectEx(DestDC As Long, DestX As Long, DestY As Long, DestWidth As Long, DestHeight As Long, SrcDC As Long, SrcX As Long, SrcY As Long, SrcWidth As Long, SrcHeight As Long)

    Dim DC As Long
    Dim hDCMemory As Long
    Dim hBmp As Long
    Dim OldhBmp As Long
    Dim hBrush As Long
    Dim Rec As RECT
    Dim PT As POINTAPI

    DC = GetDC(0)
    hDCMemory = CreateCompatibleDC(0)
    hBmp = CreateCompatibleBitmap(DC, SrcWidth, SrcHeight)
    ReleaseDC 0&, DC
    OldhBmp = SelectObject(hDCMemory, hBmp)
    BitBlt hDCMemory, 0, 0, SrcWidth, SrcHeight, SrcDC, SrcX, SrcY, vbSrcCopy
    hBrush = CreatePatternBrush(hBmp)
    SetRect Rec, DestX, DestY, DestWidth + DestX, DestHeight + DestY

    SetBrushOrgEx hdc, DestX, DestY, PT
    FillRect DestDC, Rec, hBrush
    SetBrushOrgEx hdc, PT.x, PT.y, PT

    DeleteObject hBrush
    DeleteObject SelectObject(hDCMemory, OldhBmp)
    DeleteDC hDCMemory
 End Sub

Private Sub Form_Load()
    With Picture1
        .Visible = False
        .AutoSize = True
        .ScaleMode = vbPixels
        .AutoRedraw = True
        .Picture = Me.Icon
    End With
End Sub

Private Sub Form_Paint()
    FillRectEx Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
End Sub