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

Dim hwndDest            As Long
Dim mlWidth             As Single
Dim mlHeight            As Single
Dim mbFormSwitch        As Boolean
Dim mbWindows98orHigher As Boolean

Const VER_PLATFORM_WIN32_WINDOWS = 1

Private Type FLASHWINFO
   cbSize    As Long
   hWnd      As Long
   dwFlags   As Long
   uCount    As Long
   dwTimeout As Long
End Type

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * 128
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type
Dim XY() As POINTAPI

Private Declare Function GetVersionEx Lib "kernel32" Alias _
    "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Function CreateEllipticRgn Lib "gdi32" _
    (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, _
    ByVal Y2 As Long) As Long
    
Private Declare Function CreatePolygonRgn Lib "gdi32" _
    (lpPoint As POINTAPI, ByVal nCount As Long, _
    ByVal nPolyFillMode As Long) As Long

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 Sub SetRoundCorners(ByVal NHwnd As Long)
Dim hRgn   As Long
Dim lRes   As Long
Dim XY(55) As POINTAPI
'With NObject
    '.ScaleMode = vbPixels
    'mlWidth = NObject.ScaleWidth
    'mlHeight = NObject.ScaleHeight
    GetWindowCoordinates NHwnd, , , mlHeight, , , mlWidth
    
    ' Top Left Corner.
    XY(0).X = 0
    XY(0).Y = 12
    XY(1).X = 1
    XY(1).Y = 11
    XY(2).X = 1
    XY(2).Y = 10
    XY(3).X = 2
    XY(3).Y = 9
    XY(4).X = 2
    XY(4).Y = 8
    XY(5).X = 3
    XY(5).Y = 6
    XY(6).X = 4
    XY(6).Y = 5
    XY(7).X = 5
    XY(7).Y = 4
    XY(8).X = 6
    XY(8).Y = 3
    XY(9).X = 8
    XY(9).Y = 2
    XY(10).X = 9
    XY(10).Y = 2
    XY(11).X = 10
    XY(11).Y = 1
    XY(12).X = 11
    XY(12).Y = 1
    XY(13).X = 12
    XY(13).Y = 0
    ' Top Right Corner.
    XY(14).X = mlWidth - 12
    XY(14).Y = 0
    XY(15).X = mlWidth - 1
    XY(15).Y = 1
    XY(16).X = mlWidth - 10
    XY(16).Y = 1
    XY(17).X = mlWidth - 9
    XY(17).Y = 2
    XY(18).X = mlWidth - 8
    XY(18).Y = 2
    XY(19).X = mlWidth - 6
    XY(19).Y = 3
    XY(20).X = mlWidth - 5
    XY(20).Y = 4
    XY(21).X = mlWidth - 4
    XY(21).Y = 5
    XY(22).X = mlWidth - 3
    XY(22).Y = 6
    XY(23).X = mlWidth - 2
    XY(23).Y = 8
    XY(24).X = mlWidth - 2
    XY(24).Y = 9
    XY(25).X = mlWidth - 1
    XY(25).Y = 10
    XY(26).X = mlWidth - 1
    XY(26).Y = 11
    XY(27).X = mlWidth - 0
    XY(27).Y = 12
    ' Bottom Right Corner.
    XY(28).X = mlWidth - 0
    XY(28).Y = mlHeight - 12
    XY(29).X = mlWidth - 1
    XY(29).Y = mlHeight - 11
    XY(30).X = mlWidth - 1
    XY(30).Y = mlHeight - 10
    XY(31).X = mlWidth - 2
    XY(31).Y = mlHeight - 9
    XY(32).X = mlWidth - 2
    XY(32).Y = mlHeight - 8
    XY(33).X = mlWidth - 3
    XY(33).Y = mlHeight - 6
    XY(34).X = mlWidth - 4
    XY(34).Y = mlHeight - 5
    XY(35).X = mlWidth - 5
    XY(35).Y = mlHeight - 4
    XY(36).X = mlWidth - 6
    XY(36).Y = mlHeight - 3
    XY(37).X = mlWidth - 8
    XY(37).Y = mlHeight - 2
    XY(38).X = mlWidth - 9
    XY(38).Y = mlHeight - 2
    XY(39).X = mlWidth - 10
    XY(39).Y = mlHeight - 1
    XY(40).X = mlWidth - 11
    XY(40).Y = mlHeight - 1
    XY(41).X = mlWidth - 12
    XY(41).Y = mlHeight - 0
    ' Bottom Left Corner.
    XY(42).X = 12
    XY(42).Y = mlHeight - 0
    XY(43).X = 11
    XY(43).Y = mlHeight - 1
    XY(44).X = 10
    XY(44).Y = mlHeight - 1
    XY(45).X = 9
    XY(45).Y = mlHeight - 2
    XY(46).X = 8
    XY(46).Y = mlHeight - 2
    XY(47).X = 6
    XY(47).Y = mlHeight - 3
    XY(48).X = 5
    XY(48).Y = mlHeight - 4
    XY(49).X = 4
    XY(49).Y = mlHeight - 5
    XY(50).X = 3
    XY(50).Y = mlHeight - 6
    XY(51).X = 2
    XY(51).Y = mlHeight - 8
    XY(52).X = 2
    XY(52).Y = mlHeight - 9
    XY(53).X = 1
    XY(53).Y = mlHeight - 10
    XY(54).X = 1
    XY(54).Y = mlHeight - 11
    XY(55).X = 0
    XY(55).Y = mlHeight - 12
    ' Pass in the address of the first point and
    ' the number of points.
    hRgn = CreatePolygonRgn(XY(0), (UBound(XY) + 1), 2)
    lRes = SetWindowRgn(NHwnd, hRgn, True)
    '.ScaleMode = vbTwips
'End With
End Sub


Public Sub CreateHole(ByVal NObject As Object)
' Round the outer corners of the object and
' cut a hole in the center.
Dim hRgn    As Long
Dim lRes    As Long
Dim Y       As Long
Dim X       As Long
Dim XY(113) As POINTAPI
With NObject
    .ScaleMode = vbPixels
    mlWidth = NObject.ScaleWidth
    mlHeight = NObject.ScaleHeight
    ' Top Left Corner
    XY(0).X = 0
    XY(0).Y = 12
    XY(1).X = 1
    XY(1).Y = 1
    XY(2).X = 1
    XY(2).Y = 10
    XY(3).X = 2
    XY(3).Y = 9
    XY(4).X = 2
    XY(4).Y = 8
    XY(5).X = 3
    XY(5).Y = 6
    XY(6).X = 4
    XY(6).Y = 5
    XY(7).X = 5
    XY(7).Y = 4
    XY(8).X = 6
    XY(8).Y = 3
    XY(9).X = 8
    XY(9).Y = 2
    XY(10).X = 9
    XY(10).Y = 2
    XY(11).X = 10
    XY(11).Y = 1
    XY(12).X = 11
    XY(12).Y = 1
    XY(13).X = 12
    XY(13).Y = 0
    ' Start the hole.
    XY(14).X = 40
    XY(14).Y = 0
    ' Bottom Left inside Corner.
    Y = mlHeight - 80
    XY(15).X = 40 + 0
    XY(15).Y = Y - 12
    XY(16).X = 40 + 1
    XY(16).Y = Y - 11
    XY(17).X = 40 + 1
    XY(17).Y = Y - 10
    XY(18).X = 40 + 2
    XY(18).Y = Y - 9
    XY(19).X = 40 + 2
    XY(19).Y = Y - 8
    XY(20).X = 40 + 3
    XY(20).Y = Y - 6
    XY(21).X = 40 + 4
    XY(21).Y = Y - 5
    XY(22).X = 40 + 5
    XY(22).Y = Y - 4
    XY(23).X = 40 + 6
    XY(23).Y = Y - 3
    XY(24).X = 40 + 8
    XY(24).Y = Y - 2
    XY(25).X = 40 + 9
    XY(25).Y = Y - 2
    XY(26).X = 40 + 10
    XY(26).Y = Y - 1
    XY(27).X = 40 + 11
    XY(27).Y = Y - 1
    XY(28).X = 40 + 12
    XY(28).Y = Y - 0
    ' Bottom Right Inside Corner
    X = mlWidth - 40
    XY(29).X = X - 12
    XY(29).Y = Y - 0
    XY(30).X = X - 11
    XY(30).Y = Y - 1
    XY(31).X = X - 10
    XY(31).Y = Y - 1
    XY(32).X = X - 9
    XY(32).Y = Y - 2
    XY(33).X = X - 8
    XY(33).Y = Y - 2
    XY(34).X = X - 6
    XY(34).Y = Y - 3
    XY(35).X = X - 5
    XY(35).Y = Y - 4
    XY(36).X = X - 4
    XY(36).Y = Y - 5
    XY(37).X = X - 3
    XY(37).Y = Y - 6
    XY(38).X = X - 2
    XY(38).Y = Y - 8
    XY(39).X = X - 2
    XY(39).Y = Y - 9
    XY(40).X = X - 1
    XY(40).Y = Y - 10
    XY(41).X = X - 1
    XY(41).Y = Y - 11
    XY(42).X = X - 0
    XY(42).Y = Y - 12
    ' Top Right inside Corner.
    XY(43).X = X - 0
    XY(43).Y = 80 + 12
    XY(44).X = X - 1
    XY(44).Y = 80 + 11
    XY(45).X = X - 1
    XY(45).Y = 80 + 10
    XY(46).X = X - 2
    XY(46).Y = 80 + 9
    XY(47).X = X - 2
    XY(47).Y = 80 + 8
    XY(48).X = X - 3
    XY(48).Y = 80 + 6
    XY(49).X = X - 4
    XY(49).Y = 80 + 5
    XY(50).X = X - 5
    XY(50).Y = 80 + 4
    XY(51).X = X - 6
    XY(51).Y = 80 + 3
    XY(52).X = X - 8
    XY(52).Y = 80 + 2
    XY(53).X = X - 9
    XY(53).Y = 80 + 2
    XY(54).X = X - 10
    XY(54).Y = 80 + 1
    XY(55).X = X - 11
    XY(55).Y = 80 + 1
    XY(56).X = X - 12
    XY(56).Y = 80 + 0
    ' Top left inside Corner.
    XY(57).X = 40 + 12
    XY(57).Y = 80 + 0
    XY(58).X = 40 + 11
    XY(58).Y = 80 + 1
    XY(59).X = 40 + 10
    XY(59).Y = 80 + 1
    XY(60).X = 40 + 9
    XY(60).Y = 80 + 2
    XY(61).X = 40 + 8
    XY(61).Y = 80 + 2
    XY(62).X = 40 + 6
    XY(62).Y = 80 + 3
    XY(63).X = 40 + 5
    XY(63).Y = 80 + 4
    XY(64).X = 40 + 4
    XY(64).Y = 80 + 5
    XY(65).X = 40 + 3
    XY(65).Y = 80 + 6
    XY(66).X = 40 + 2
    XY(66).Y = 80 + 8
    XY(67).X = 40 + 2
    XY(67).Y = 80 + 9
    XY(68).X = 40 + 1
    XY(68).Y = 80 + 10
    XY(69).X = 40 + 1
    XY(69).Y = 80 + 11
    XY(70).X = 40 + 0
    XY(70).Y = 80 + 12
    ' Close the hole and return
    ' to the outside border.
    XY(71).X = 40
    XY(71).Y = 0
    ' Top Right Corner.
    XY(72).X = mlWidth - 12
    XY(72).Y = 0
    XY(73).X = mlWidth - 11
    XY(73).Y = 1
    XY(74).X = mlWidth - 10
    XY(74).Y = 1
    XY(75).X = mlWidth - 9
    XY(75).Y = 2
    XY(76).X = mlWidth - 8
    XY(76).Y = 2
    XY(77).X = mlWidth - 6
    XY(77).Y = 3
    XY(78).X = mlWidth - 5
    XY(78).Y = 4
    XY(79).X = mlWidth - 4
    XY(79).Y = 5
    XY(80).X = mlWidth - 3
    XY(80).Y = 6
    XY(81).X = mlWidth - 2
    XY(81).Y = 8
    XY(82).X = mlWidth - 2
    XY(82).Y = 9
    XY(83).X = mlWidth - 1
    XY(83).Y = 10
    XY(84).X = mlWidth - 1
    XY(84).Y = 11
    XY(85).X = mlWidth - 0
    XY(85).Y = 12
    ' Bottom Right Corner.
    XY(86).X = mlWidth - 0
    XY(86).Y = mlHeight - 12
    XY(87).X = mlWidth - 1
    XY(87).Y = mlHeight - 11
    XY(88).X = mlWidth - 1
    XY(88).Y = mlHeight - 10
    XY(89).X = mlWidth - 2
    XY(89).Y = mlHeight - 9
    XY(90).X = mlWidth - 2
    XY(90).Y = mlHeight - 8
    XY(91).X = mlWidth - 3
    XY(91).Y = mlHeight - 6
    XY(92).X = mlWidth - 4
    XY(92).Y = mlHeight - 5
    XY(93).X = mlWidth - 5
    XY(93).Y = mlHeight - 4
    XY(94).X = mlWidth - 6
    XY(94).Y = mlHeight - 3
    XY(95).X = mlWidth - 8
    XY(95).Y = mlHeight - 2
    XY(96).X = mlWidth - 9
    XY(96).Y = mlHeight - 2
    XY(97).X = mlWidth - 10
    XY(97).Y = mlHeight - 1
    XY(98).X = mlWidth - 11
    XY(98).Y = mlHeight - 1
    XY(99).X = mlWidth - 12
    XY(99).Y = mlHeight - 0
    ' Bottom Left Corner.
    XY(100).X = 12
    XY(100).Y = mlHeight - 0
    XY(101).X = 11
    XY(101).Y = mlHeight - 1
    XY(102).X = 10
    XY(102).Y = mlHeight - 1
    XY(103).X = 9
    XY(103).Y = mlHeight - 2
    XY(104).X = 8
    XY(104).Y = mlHeight - 2
    XY(105).X = 6
    XY(105).Y = mlHeight - 3
    XY(106).X = 5
    XY(106).Y = mlHeight - 4
    XY(107).X = 4
    XY(107).Y = mlHeight - 5
    XY(108).X = 3
    XY(108).Y = mlHeight - 6
    XY(109).X = 2
    XY(109).Y = mlHeight - 8
    XY(110).X = 2
    XY(110).Y = mlHeight - 9
    XY(111).X = 1
    XY(111).Y = mlHeight - 10
    XY(112).X = 1
    XY(112).Y = mlHeight - 11
    XY(113).X = 0
    XY(113).Y = mlHeight - 12
    ' Pass in the address of the first point and
    ' the number of points.
    hRgn = CreatePolygonRgn(XY(0), (UBound(XY) + 1), 2)
    lRes = SetWindowRgn(.hWnd, hRgn, True)
End With
End Sub

Private Function fGetOSVersion()
Dim os As OSVERSIONINFO
' Returns True if Win98 or Win2000
fGetOSVersion = False
With os
    .dwOSVersionInfoSize = Len(os)
    Call GetVersionEx(os)
    ' Windows 2000
    If .dwMajorVersion > 4 Then fGetOSVersion = True
    If .dwMajorVersion = 4 And _
       .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
       .dwMinorVersion > 0 Then
        fGetOSVersion = True
    End If
End With
End Function

Public Sub SetElliptic(obj As Object)
Dim lTop    As Long
Dim lLeft   As Long
Dim lRight  As Long
Dim lBottom As Long
Dim lRegHnd As Long
With obj
    lRight = .Width / Screen.TwipsPerPixelX
    lBottom = .Height / Screen.TwipsPerPixelY
    lRegHnd = CreateEllipticRgn(lLeft + 1, lTop + 1, lRight - 1, lBottom - 1)
    Call SetWindowRgn(.hWnd, lRegHnd, True)
End With
End Sub

Public Sub ResetForm(ByVal NHwnd As Long)
Dim lTop    As Single
Dim lLeft   As Single
Dim lRight  As Single
Dim lBottom As Single
Dim lRegHnd As Single
'With obj
    'lRight = .Width / Screen.TwipsPerPixelX
    'lBottom = .Height / Screen.TwipsPerPixelY
    GetWindowCoordinates NHwnd, , , lBottom, , , lRight
    lRegHnd = CreateEllipticRgn(lLeft + 1, lTop + 1, lRight - 1, lBottom - 1)
    lRegHnd = 0
    Call SetWindowRgn(NHwnd, lRegHnd, True)
'End With
End Sub

Public Sub SetRound(ByVal NHwnd As Long)
Dim lTop    As Long
Dim lLeft   As Single
Dim lRight  As Single
Dim lBottom As Single
Dim lRegHnd As Long
'obj.Height = obj.Width
'With obj
    GetWindowCoordinates NHwnd, , , lBottom, , , lRight
    'lRight = lRight / Screen.TwipsPerPixelX
    'lBottom = lBottom / Screen.TwipsPerPixelY
    lRegHnd = CreateEllipticRgn(lLeft + 1, lTop + 1, lRight - 1, lBottom - 1)
    Call SetWindowRgn(NHwnd, lRegHnd, True)
'End With
End Sub

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)
    SetWindowRgn NHwndTarget, lRgn, True
    DeleteObject lRgn
    
End Sub
