Option Explicit
 
' Benötigte API-Deklarationen
Private Declare Function SetWindowRgn Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal hRgn As Long, _
  ByVal bRedraw As Boolean) 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 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 DeleteObject Lib "gdi32" ( _
  ByVal hObject As Long) As Long
 
Private Const RGN_OR = 2
 
' Nachfolgender Code verformt eine Form
' anhand eines Bildes
Public Sub SkinPic(picSkin As Control, _
  picSource As PictureBox)
 
  Dim WindowRegion As Long
 
  ' Picture in PictureBox laden
  ' und Eigenschaften festlegen
  With picSource
    .Visible = False
    .ScaleMode = vbPixels
    .AutoRedraw = True
    .AutoSize = True
    .BorderStyle = vbBSNone
 
  End With
 
  ' Formgröße des Skin-Pictures anpassen
  ' und Windows-Region erstellen
  With picSkin
    .Width = picSource.Width  'picSkin.ScaleX(picSource.Width, .ScaleMode, 
    ' vbTwips)
    .Height = picSource.Height 'picSkin.ScaleY(picSource.Height, .ScaleMode, 
    ' vbTwips)
 
    WindowRegion = MakeRegion(picSource)
    SetWindowRgn .hWnd, WindowRegion, False
    'DeleteObject WindowRegion
    .Refresh
    .Picture = picSource.Picture
  End With
 
End Sub
 
Private Function MakeRegion(picSkin As PictureBox) As Long
  ' Diese Funktion erstellt eine Windows-Region basierend
  ' auf das Bild der übergebenen PictureBox.
  '
  ' Hierbei werden alle "transparenten" Bildpunkte zu einer
  ' Region zusammengefasst.
 
  Dim X As Long, Y As Long, StartLineX As Long
  Dim FullRegion As Long, LineRegion As Long
  Dim TransparentColor As Long
  Dim InFirstRegion As Boolean
  Dim InLine As Boolean
  Dim hdc As Long
  Dim PicWidth As Long
  Dim PicHeight As Long
 
  With picSkin
    hdc = .hdc
    PicWidth = .ScaleWidth
    PicHeight = .ScaleHeight
  End With
 
  InFirstRegion = True: InLine = False
  X = Y = StartLineX = 0
 
  ' Als transparente Farbe wird der oberste linke Farbpunkt
  ' herangezogen.
  ' Sie können aber auch Ihre eigene durchsichtige Farbe
  ' definieren wie z.B. pink oder einen Hexwert wie &H00C00000&
  ' oder als RGB(50, 14, 254) oder vbBlack, vbwhite etc.
 
  TransparentColor = GetPixel(hdc, 0, 0)
  For Y = 0 To PicHeight - 1
    For X = 0 To PicWidth - 1
      If GetPixel(hdc, X, Y) = TransparentColor Or X = PicWidth Then
        ' Wir haben einen durchsichtigen pixel erreicht
        If InLine Then
          InLine = False
          LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
 
          If InFirstRegion Then
            FullRegion = LineRegion
            InFirstRegion = False
          Else
            CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
            ' Immer säubern!
            DeleteObject LineRegion
          End If
        End If
      Else
        ' Wir haben einen nicht durchsichtigen pixel erreicht
        If Not InLine Then
          InLine = True
          StartLineX = X
        End If
      End If
    Next X
  Next Y
 
  MakeRegion = FullRegion
End Function