Option Explicit

Private Const RGN_OR        As Long = 2
Private Const CLR_INVALID   As Long = &HFFFFFFFF
Private Const WindowBounds  As Long = 3
Private Const WS_EX_LAYERED As Long = &H80000
Private Const LWA_ALPHA     As Long = &H2
Private Const GWL_EXSTYLE   As Long = -20

Private Declare Function FindWindow Lib "user32" Alias _
      "FindWindowA" (ByVal lpClassName As String, _
      ByVal lpWindowName As String) As Long

Private Declare Function GetWindowLong Lib "user32" Alias _
      "GetWindowLongA" (ByVal hWnd As Long, _
      ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias _
      "SetWindowLongA" (ByVal hWnd As Long, _
      ByVal nIndex As Long, ByVal dwNewIndex As Long) _
      As Long

Private Declare Function DrawMenuBar Lib "user32" _
      (ByVal hWnd As Long) As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Declare Function SendMessage Lib "user32" Alias _
      "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
      ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function SetLayeredWindowAttributes Lib "user32" _
      (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha _
      As Byte, ByVal dwFlags As Long) As Long

Private Declare Function GetDC Lib "user32" _
      (ByVal hWnd As Long) As Long

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 SetWindowRgn Lib "user32" (ByVal hWnd _
      As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd _
      As Long, ByVal hdc As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" _
                         (ByVal hObject As Long) As Long

#If VBA6 Then
   Private WithEvents e_UserForm As MSForms.UserForm
#Else
   Private e_UserForm As MSForms.UserForm
#End If

Private m_TransparentColor As Long

Private m_hWndForm As Long
Private m_hSkinRgn As Long
Private m_hFormRgn As Long

Private Sub ChangeWindowTransparenz(ByVal hWnd As Long, _
      ByVal cAlpha As Byte)
  Dim lStyle As Long

  lStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
  lStyle = lStyle Or WS_EX_LAYERED
  SetWindowLong hWnd, GWL_EXSTYLE, lStyle
  SetLayeredWindowAttributes hWnd, ByVal 0&, cAlpha, LWA_ALPHA
End Sub

Private Function MakeTransparentRegion(ByVal hdc As Long, _
      ByVal lHeigth As Long, ByVal lWidth As Long, _
      ByVal TransparentColor As Long) As Long

  Dim lSkinRgn  As Long
  Dim lTempRgn  As Long
  Dim StartRgnX As Long
  Dim StartRgn  As Boolean

  Dim PixColor  As Long

  Dim Y As Long
  Dim X As Long

  lSkinRgn = CreateRectRgn(0, 0, 0, 0)

  For Y = 0 To lHeigth - 1
    StartRgnX = 0
    StartRgn = False

    For X = 0 To lWidth
      PixColor = GetPixel(hdc, X, Y)
      If PixColor <> TransparentColor And _
            PixColor <> CLR_INVALID Then
        If StartRgn = False Then
          StartRgn = True
          StartRgnX = X
        End If

      Else
        If StartRgn = True Then
          lTempRgn = CreateRectRgn(StartRgnX + WindowBounds + 1, _
                Y + WindowBounds + 1, X + WindowBounds, _
                Y + WindowBounds)

          Call CombineRgn(lSkinRgn, lSkinRgn, lTempRgn, RGN_OR)
          Call DeleteObject(lTempRgn)
          StartRgn = False
        End If
       End If
     Next X
  Next Y

  MakeTransparentRegion = lSkinRgn
End Function

Public Sub Form_Initialize(ByRef objForm As Object, _
      ByVal TransparentColor As Long)

  Set e_UserForm = objForm
  m_TransparentColor = TransparentColor

  objForm.BorderStyle = fmBorderStyleNone
  objForm.BackColor = m_TransparentColor

  Dim strUFCaption As String

  strUFCaption = objForm.Caption
  objForm.Caption = "Dummy-Caption - djadljfepgtjaejhkaeljljaelji"
  m_hWndForm = FindWindow(vbNullString, objForm.Caption)
  objForm.Caption = strUFCaption

  If m_hWndForm <> 0 Then
    SetWindowLong m_hWndForm, -16, _
          GetWindowLong(m_hWndForm, -16) And Not &H400000
    DrawMenuBar m_hWndForm
    ChangeWindowTransparenz m_hWndForm, 0
  End If
End Sub

Public Sub Form_Activate()
  Dim hWndDC As Long

  e_UserForm.Repaint

  If m_hWndForm <> 0 Then
    hWndDC = GetDC(m_hWndForm)
    m_hSkinRgn = MakeTransparentRegion(hWndDC, _
          e_UserForm.InsideHeight / 0.748, _
          e_UserForm.InsideWidth / 0.748, _
          m_TransparentColor)

    m_hFormRgn = SetWindowRgn(m_hWndForm, m_hSkinRgn, True)
    ReleaseDC m_hWndForm, hWndDC

    ChangeWindowTransparenz m_hWndForm, 255
  End If
End Sub

Public Sub e_UserForm_MouseDown(ByVal Button As Integer, ByVal _
      Shift As Integer, ByVal X As Single, ByVal Y As Single)

  If Button = 1 Then
    If m_hWndForm <> 0 Then
      ReleaseCapture
      SendMessage m_hWndForm, &HA1, 2, 0
    End If
  End If
End Sub

Private Sub Class_Terminate()
  If m_hWndForm <> 0 Then
    DeleteObject m_hFormRgn
    DeleteObject m_hSkinRgn
    SetWindowLong m_hWndForm, -16, _
          GetWindowLong(m_hWndForm, -16) Or &H400000
  End If
  Set e_UserForm = Nothing
End Sub

Option Explicit

Private m_objCFormSkin As CFormSkin

Private Sub UserForm_Initialize()
  With Me.cmdExit
    .Cancel = True
    .Default = True

    .BackColor = &HC0C0&
    .ForeColor = vbBlack
  End With

  Set m_objCFormSkin = New CFormSkin
  Call m_objCFormSkin.Form_Initialize(Me, RGB(178, 31, 114))
End Sub

Private Sub UserForm_Activate()
  Call m_objCFormSkin.Form_Activate
End Sub

#If VBA6 = False Then
   Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal _
          Shift As Integer, ByVal X As Single, ByVal Y As Single)
     Call m_objCFormSkin.e_UserForm_MouseDown(Button, Shift, X, Y)
   End Sub
#End If

Private Sub cmdExit_Click()
  Unload Me
End Sub

Private Sub UserForm_Terminate()
  Set m_objCFormSkin = Nothing
End Sub