Attribute VB_Name = "SafeMode"
Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As _
        Long, ByVal XDest As Long, ByVal YDest As Long, ByVal _
        nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc _
        As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal _
        dwRop 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

Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As _
        Long, ByVal crColor As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As _
        Long, ByVal hObject As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc _
        As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) _
        As Long

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

Public Sub MonoMask(Source As PictureBox, ByVal MaskColor&, _
                     Mask1 As PictureBox)
                     
  Dim hDCMask1&, hMask1&, hDCMask2&, hMask2&
  Dim hPrevMask1&, hPrevMask2&, W&, H&
    
    W = Source.Width
    H = Source.Height
    Mask1.Width = W
    Mask1.Height = H
       
    'Generieren zweier Bitmaps
    hDCMask1 = CreateCompatibleDC(Mask1.hdc)

    
    hMask1 = CreateBitmap(W, H, 1, 1, ByVal 0&)

    
    hPrevMask1 = SelectObject(hDCMask1, hMask1)


    'Maskenfarbe des Originalbildes festlegen
    Call SetBkColor(Source.hdc, MaskColor)
    
    'Monochrome Maske des Originalbildes erstellen
    Call BitBlt(hDCMask1, 0, 0, W, H, Source.hdc, _
                0, 0, vbSrcCopy)
    
    'Erstellte monochrome Maske nach Picture4 kopieren
    Call BitBlt(Mask1.hdc, 0, 0, W, H, _
                hDCMask1, 0, 0, vbSrcCopy)
         
    'Inverse Maske der erstellen Maske generieren

    'Erstellte inverse Maske nach MaskInvers kopieren
 

    'Erstellte Objekte & DCs wieder freigeben
    Call DeleteObject(SelectObject(hDCMask1, hPrevMask1))
    Call DeleteDC(hDCMask1)

End Sub




