Option Explicit

Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal _
    destHdc As Long, ByVal DestX As Long, ByVal DestY As Long, _
    ByVal destWidth As Long, ByVal destHeight As Long, ByVal _
    srcHdc As Long, ByVal SrcX As Long, ByVal SrcY As Long, _
    ByVal srcWidth As Long, ByVal scrHeight As Long, ByVal _
    BLENDFUNCT As Long) As Long

Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal _
    hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth _
    As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal _
    xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, _
    ByVal nSrcHeight As Long, ByVal crTransparent As Long) _
    As Boolean

Sub AlphaBlit(DestPic As PictureBox, SourcePic As PictureBox, _
    ByVal Prozent As Single, Optional DestX As Long, Optional _
    DestY As Long, Optional DestW As Long, Optional DestH _
    As Long, Optional SrcX As Long, Optional SrcY As Long, _
    Optional SrcW As Long, Optional SrcH As Long)

  If SrcW = 0 Then SrcW = SourcePic.ScaleWidth
  If SrcH = 0 Then SrcH = SourcePic.ScaleHeight
  If DestW = 0 Then DestW = SourcePic.ScaleWidth
  If DestH = 0 Then DestH = SourcePic.ScaleHeight

  AlphaBlend DestPic.hdc, DestX, DestY, DestW, DestH, _
      SourcePic.hdc, SrcX, SrcY, SrcW, SrcH, GetBlendVal(Prozent)
End Sub

Sub AlphaBlitTransparent(DestPic As PictureBox, SourcePic As _
      PictureBox, ByVal Prozent As Single, Optional DestX _
      As Long, Optional DestY As Long, Optional DestW As Long, _
      Optional DestH As Long, Optional SrcX As Long, Optional _
      SrcY As Long, Optional SrcW As Long, Optional SrcH As Long, _
      Optional TranspColor As Long = -1)

  If SrcW = 0 Then SrcW = SourcePic.ScaleWidth
  If SrcH = 0 Then SrcH = SourcePic.ScaleHeight
  If DestW = 0 Then DestW = SourcePic.ScaleWidth
  If DestH = 0 Then DestH = SourcePic.ScaleHeight

  picTemp.Width = SourcePic.Width
  picTemp.Height = SourcePic.Height
  picTemp.PaintPicture _
        DestPic, 0, 0, DestW, DestH, DestX, DestY, DestW, DestH

  If TranspColor = -1 Then TranspColor = SourcePic.Point(0, 0)

  TransparentBlt picTemp.hdc, 0, 0, DestW, DestH, _
        SourcePic.hdc, SrcX, SrcY, SrcW, SrcH, TranspColor

  AlphaBlend DestPic.hdc, DestX, DestY, DestW, DestH, _
        picTemp.hdc, 0, 0, DestW, DestH, _
        GetBlendVal(Prozent)
End Sub

Private Function GetBlendVal(ByVal Prozent As Single) As Long
  If Prozent < 0 Then Prozent = 0
  If Prozent > 100 Then Prozent = 100
  GetBlendVal = CLng(Prozent / 100 * 255) * &H10000
End Function

Private Sub Form_Load()
  hscOpacity_Change
End Sub

Private Sub hscOpacity_Change()
  lblProzent.Caption = hscOpacity.Value

  picDestination.Cls

  If chkTransparent.Value Then
    AlphaBlitTransparent picDestination, picObject, _
          hscOpacity.Value, DestX:=110, DestY:=62
  Else
    AlphaBlit picDestination, picObject, hscOpacity.Value, _
          DestX:=110, DestY:=62
  End If
End Sub