Option Explicit

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) _
      As Long

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

Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 _
      As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 _
      As Long) As Long

Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn _
      As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, _
      ByVal nCombineMode As Long) As Long

Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, _
      ByVal x As Long, ByVal y As Long) As Long

Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd _
      As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Public cmdDc As Long

Public Function picTranz(cPic As PictureBox) As Long
  Dim lHoch As Long
  Dim lBreit As Long
  Dim lTemp As Long
  Dim lSkin As Long
  Dim lStart As Long
  Dim lZeile As Long
  Dim lSpalte As Long
  Dim lBackColor As Long

  lSkin = CreateRectRgn(0, 0, 0, 0)

  With cPic
    lHoch = .Height / Screen.TwipsPerPixelY
    lBreit = .Width / Screen.TwipsPerPixelX

    lBackColor = GetPixel(.hDC, 0, 0)

    For lZeile = 0 To lHoch - 1
      lSpalte = 0
      Do While lSpalte < lBreit
        Do While lSpalte < lBreit And _
              GetPixel(.hDC, lSpalte, lZeile) = lBackColor
          lSpalte = lSpalte + 1
        Loop

        If lSpalte < lBreit Then
          lStart = lSpalte
          Do While lSpalte < lBreit And _
                GetPixel(.hDC, lSpalte, lZeile) <> lBackColor
            lSpalte = lSpalte + 1
          Loop

          If lSpalte > lBreit Then lSpalte = lBreit
          lTemp = _
              CreateRectRgn(lStart, lZeile, lSpalte, lZeile + 1)
          Call CombineRgn(lSkin, lSkin, lTemp, 2)
          Call DeleteObject(lTemp)
        End If
      Loop
    Next lZeile
  End With

  picTranz = lSkin
End Function

Public Sub picTransparent(cPic As PictureBox)
  Dim lSkin As Long

  With cPic
    .Visible = True
    .Left = 0
    .Top = 0
    .BorderStyle = 0
    .AutoRedraw = True
    .AutoSize = True
    lSkin = picTranz(cPic)
    Call SetWindowRgn(cPic.hwnd, lSkin, True)
  End With
End Sub

Public Function cmdTranz(cBttn As CommandButton) As Long
  Dim lHoch As Long
  Dim lBreit As Long
  Dim lTemp As Long
  Dim lSkin As Long
  Dim lStart As Long
  Dim lZeile As Long
  Dim lSpalte As Long
  Dim lBackColor As Long

  lSkin = CreateRectRgn(0, 0, 0, 0)

  With cBttn
    lHoch = .Height / Screen.TwipsPerPixelY
    lBreit = .Width / Screen.TwipsPerPixelX

    cmdDc = GetDC(.hwnd)
    lBackColor = cBttn.BackColor

    For lZeile = 2 To lHoch - 3
      lSpalte = 2
      Do While lSpalte < (lBreit - 3)
        Do While lSpalte < (lBreit - 3) And _
              GetPixel(cmdDc, lSpalte, lZeile) = lBackColor
          lSpalte = lSpalte + 1
        Loop

        If lSpalte < (lBreit - 3) Then
          lStart = lSpalte
          Do While lSpalte < (lBreit - 3) And _
                GetPixel(cmdDc, lSpalte, lZeile) <> lBackColor
            lSpalte = lSpalte + 1
          Loop

          If lSpalte > lBreit Then lSpalte = lBreit
          lTemp = _
              CreateRectRgn(lStart, lZeile, lSpalte, lZeile + 1)
          Call CombineRgn(lSkin, lSkin, lTemp, 2)
          Call DeleteObject(lTemp)
        End If
      Loop
    Next lZeile
  End With

  cmdTranz = lSkin
End Function

Public Sub cmdTransparent(cBttn As CommandButton)
  Dim lSkin As Long

  With cBttn
    .Visible = True
    .Left = cBttn.Left
    .Top = cBttn.Top
    lSkin = cmdTranz(cBttn)
    Call SetWindowRgn(cBttn.hwnd, lSkin, True)
  End With
End Sub

Option Explicit

Private Sub cmdTranz_Click(Index As Integer)
  Select Case Index
    Case 0: picTransparent pic1
    Case 1: cmdTransparent cmd1: cmdTransparent _
            cmd2: cmdTransparent cmd3: cmdTransparent _
            cmd4: cmdTranz(1).Enabled = False
  End Select
End Sub