Attribute VB_Name = "Buttons"
Option Explicit

Public Type POINTAPI
  X As Long
  Y As Long
End Type

Public Declare Function AlphaBlend Lib "MSIMG32.dll" ( _
  ByVal hdcDest As Long, _
  ByVal nXOriginDest As Long, _
  ByVal nYOriginDest As Long, _
  ByVal nWidthDest As Long, _
  ByVal nHeightDest As Long, _
  ByVal hdcSrc As Long, _
  ByVal nXOriginSrc As Long, _
  ByVal nYOriginSrc As Long, _
  ByVal nWidthSrc As Long, _
  ByVal nHeightSrc As Long, _
  ByVal lBlendFunction As Long _
) As Long

Private Type BLENDFUNCTION
  BlendOp As Byte
  BlendFlags As Byte
  SourceConstantAlpha As Byte
  AlphaFormat As Byte
End Type

Private Const AC_SRC_OVER = &H0
Private Const AC_SRC_ALPHA = &H1
Private Const BITSPIXEL = 12
Private Const PLANES = 14

'Public Declare Function AlphaBlend Lib "MSIMG32.dll" (ByVal hDC As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hDC As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Public Declare Function GetCapture Lib "user32" () As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth _
        As Long, ByVal nHeight As Long, ByVal nPlanes As Long, _
        ByVal nBitCount As Long, lpBits As Any) As Long

Public Function Is32BitColor() As Boolean
  Is32BitColor = (GetDeviceCaps(Form1.hDC, BITSPIXEL) = 32)
End Function


Private Sub TranspPic(OutDstDC&, DstDC&, SrcDC&, ByVal ScrX&, ByVal ScrY&, ByVal ScrW&, _
  ByVal ScrH&, ByVal DstX&, ByVal DstY&, TransColor&)
 
  Dim Result&, W&, H&
  Dim MonoMaskDC&, hMonoMask&, MonoInvDC&, hMonoInv&
  Dim ResultDstDC&, hResultDst&, ResultSrcDC&, hResultSrc&
  Dim hPrevMask&, hPrevInv&, hPrevSrc&, hPrevDst&
    
    W = ScrW
    H = ScrH
     
    'Generieren einer Monochromen & einer inversen Maske
    MonoMaskDC = CreateCompatibleDC(DstDC)
    MonoInvDC = CreateCompatibleDC(DstDC)
    hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
    hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&)
    hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
    hPrevInv = SelectObject(MonoInvDC, hMonoInv)
     
    'Puffer erstellen
    ResultDstDC = CreateCompatibleDC(DstDC)
    ResultSrcDC = CreateCompatibleDC(DstDC)
    hResultDst = CreateCompatibleBitmap(DstDC, W, H)
    hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
    hPrevDst = SelectObject(ResultDstDC, hResultDst)
    hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
     
    'Sourcebild in die monochrome Maske kopieren
    Dim OldBC As Long
    OldBC = SetBkColor(SrcDC, TransColor)
    Result = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, _
                  ScrX, ScrY, vbSrcCopy)
    TransColor = SetBkColor(SrcDC, OldBC)
     
    'Inverse Maske erstellen
    Result = BitBlt(MonoInvDC, 0, 0, W, H, _
                  MonoMaskDC, 0, 0, vbNotSrcCopy)
     
    'Hintergrund des Zielbildes auslesen
    Result = BitBlt(ResultDstDC, 0, 0, W, H, _
                  DstDC, DstX, DstY, vbSrcCopy)
     
    'AND mit der Maske
    Result = BitBlt(ResultDstDC, 0, 0, W, H, _
                  MonoMaskDC, 0, 0, vbSrcAnd)
     
    'Überlappung des Sourcebildes mit dem Zielbild auslesen
    Result = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, _
                  ScrX, ScrY, vbSrcCopy)
     
    'AND mit der invertierten, monochromen Maske
    Result = BitBlt(ResultSrcDC, 0, 0, W, H, _
                  MonoInvDC, 0, 0, vbSrcAnd)
     
    'XOR mit beiden
    Result = BitBlt(ResultDstDC, 0, 0, W, H, _
                  ResultSrcDC, 0, 0, vbSrcInvert)
     
    'Ergebnis in das Zielbild kopieren
    Result = BitBlt(OutDstDC, DstX, DstY, W, H, _
                  ResultDstDC, 0, 0, vbSrcCopy)
     
    'Erstellte Objekte & DCs wieder freigeben
    hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
    DeleteObject hMonoMask
    DeleteDC MonoMaskDC
    
    hMonoInv = SelectObject(MonoInvDC, hPrevInv)
    DeleteObject hMonoInv
    DeleteDC MonoInvDC
    
    hResultDst = SelectObject(ResultDstDC, hPrevDst)
    DeleteObject hResultDst
    DeleteDC ResultDstDC
    
    hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
    DeleteObject hResultSrc
    DeleteDC ResultSrcDC
End Sub

Public Sub PrintIcon(Obj As Object, ByVal X As Single, ByVal Y As Single, ByVal Index As Integer)
  Dim sX As Integer
  Dim sY As Integer
  Dim lBlend As Long
  Dim bf As BLENDFUNCTION
  
  sY = Int(Index / 20)
  sX = Index - (sY * 20)
  If IsNt And Is32BitColor Then
    bf.BlendOp = AC_SRC_OVER
    bf.BlendFlags = 0
    bf.SourceConstantAlpha = 255
    bf.AlphaFormat = AC_SRC_ALPHA
    CopyMemory lBlend, bf, 4
    AlphaBlend Obj.hDC, X, Y, 16, 16, Form1.IconStaw.hDC, sX * 16, sY * 16, 16, 16, lBlend
  Else
    TranspPic Obj.hDC, Obj.hDC, Form1.IconStaw.hDC, sX * 16, sY * 16, 16, 16, X, Y, 0  ' RGB(255, 0, 255)
  End If
End Sub


