Attribute VB_Name = "IrregularForm"
Option Explicit

Public Const RGN_COPY = 5
Public Const RGN_AND = 1
Public Const RGN_XOR = 3
Public Const RGN_OR = 2
Private Const HWND_BOTTOM = 1
Public Const HWND_TOP = 0

Private Declare Function SetWindowRgn Lib "user32" _
    (ByVal hwnd As Long, ByVal hRgn As Long, _
    ByVal bRedraw As Long) As Long
    
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
    
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Declare Function GetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long) As Long

Public Function lGetRegion(pic As PictureBox, lBackColor As Long) As Long
    Dim lRgn As Long
    Dim lSkinRgn As Long
    Dim lStart As Long
    Dim lX As Long
    Dim lY As Long
    Dim lHeight As Long
    Dim lWidth As Long

    lSkinRgn = CreateRectRgn(0, 0, 0, 0)
    
    With pic
        lHeight = .Height / Screen.TwipsPerPixelY
        lWidth = .Width / Screen.TwipsPerPixelX
        For lX = 0 To lHeight - 1
            lY = 0
            Do While lY < lWidth

                Do While lY < lWidth And GetPixel(.hDC, lY, lX) = lBackColor
                    lY = lY + 1
                Loop
    
                If lY < lWidth Then
                    lStart = lY
                    Do While lY < lWidth And GetPixel(.hDC, lY, lX) <> lBackColor
                        lY = lY + 1
                    Loop
                    If lY > lWidth Then lY = lWidth

                    lRgn = CreateRectRgn(lStart, lX, lY, lX + 1)
                    CombineRgn lSkinRgn, lSkinRgn, lRgn, RGN_OR
                    DeleteObject lRgn
                End If
            Loop
        Next
    End With
    
    lGetRegion = lSkinRgn
End Function

Public Sub CreateSkin(NHwndTarget As Long, NPictureBoxSource As PictureBox, Optional ByVal nColor As Long = -1, Optional nX As Long = 0, Optional nY As Long = 0)
    Dim lRgn As Long
    Dim StartColor As Long
    
    NPictureBoxSource.AutoRedraw = True
    If nColor = -1 Then
        StartColor = GetPixel(NPictureBoxSource.hDC, nX, nY)
    Else
        StartColor = nColor
    End If
    lRgn = lGetRegion(NPictureBoxSource, StartColor)
    Debug.Print lRgn
    SetWindowRgn NHwndTarget, lRgn, True
    DeleteObject lRgn
    
End Sub
