Public Property Get BackColor() As Long
    BackColor = lngBackColor
End Property

Public Property Let BackColor(ByVal vNewValue As Long)
    Dim R As Long
    Dim G As Long
    Dim B As Long
    
    'If vNewValue  lngBackColor Then
        lngBackColor = vNewValue
        R = lngBackColor And &HFF&
        G = (lngBackColor And &HFF00&) \ &H100&
        B = (lngBackColor And &HFF0000) \ &H10000
        For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 3 Step 3
            For Y = 0 To bm.bmHeight - 1
                If ImageData(X + 2, Y) = ImageData(2, 0) And ImageData(X + 1, Y) = ImageData(1, 0) And ImageData(X, Y) = ImageData(0, 0) Then
                    ImageData(X + 2, Y) = R
                    ImageData(X + 1, Y) = G
                    ImageData(X, Y) = B
                End If
            Next Y
        Next X
    'End If
End Property

Option Explicit

Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) _
As Long

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbAlpha As Byte
End Type

Private Type BITMAPINFOHEADER
    bmSize As Long
    bmWidth As Long
    bmHeight As Long
    bmPlanes As Integer
    bmBitCount As Integer
    bmCompression As Long
    bmSizeImage As Long
    bmXPelsPerMeter As Long
    bmYPelsPerMeter As Long
    bmClrUsed As Long
    bmClrImportant As Long
End Type

Private Type BITMAPINFO
    bmHeader As BITMAPINFOHEADER
    bmColors(0 To 255) As RGBQUAD
End Type

Private Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, _
ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As _
Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Private Declare Function StretchDIBits Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal dWidth As Long, ByVal dHeight _
As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As _
Long, ByVal SrcHeight As Long, lpBits As Any, lpBI As BITMAPINFO, _
ByVal wUsage As Long, ByVal RasterOp As Long) As Long

Dim ImageData() As Byte
Dim ImageDataChanged() As Byte
Dim ImageDataMask() As Byte
Dim blnTransparent As Boolean
Dim bm As BITMAP
Dim bmi As BITMAPINFO
Dim bmLen As Long
Dim X As Long
Dim Y As Long
Dim lngBackColor As Long

Private Function ByteAlignOnWord(ByVal bitDepth As Byte, ByVal Width As Long) As Long
    ' function to align any bit depth on dWord boundaries
    ByteAlignOnWord = (((Width * bitDepth) + &H1F&) And Not &H1F&) \ &H8&
End Function


'Routine to get an image's pixel information into an array dimensioned (rgb, x, y)
Public Sub GetImageData(ByRef SrcPictureBox As Control)
      
    bmi.bmHeader.bmSize = 40 'Size, in bytes, of the header (always 40)
    bmi.bmHeader.bmPlanes = 1 'Number of planes (always one)
    bmi.bmHeader.bmBitCount = 24 'Bits per pixel (always 24 for image processing)
    bmi.bmHeader.bmCompression = 0 'Compression: none or RLE (always zero)

    'Calculate the size of the bitmap type (in bytes)
    
    bmLen = Len(bm)

    'Get the picture box information from SrcPictureBox and put it into our 'bm' variable
    GetObject SrcPictureBox.Image, bmLen, bm
    
    'Build a correctly sized array.
    ReDim ImageData(0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)

    'Finish building the 'bmi' variable we want to pass to the GetDIBits call (the same variable we used above)
    bmi.bmHeader.bmWidth = bm.bmWidth
    bmi.bmHeader.bmHeight = bm.bmHeight

    'Now that we've completely filled up the 'bmi' variable, we use GetDIBits to take the data from SrcPictureBox and put it into the ImageData() array using the settings we specified in 'bmi'
    GetDIBits SrcPictureBox.hDC, SrcPictureBox.Image, 0, bm.bmHeight, ImageData(0, 0), bmi, 0
    lngBackColor = RGB(ImageData(2, 0), ImageData(1, 0), ImageData(0, 0))
End Sub

'Routine to set an image's pixel information from an array dimensioned(rgb, x, y)
Public Sub DrawImageData(ByRef DstPictureBox As Control, Optional ByRef X As Long = 0, Optional ByRef Y As Long = 0)
    
    Dim blnAutoRedraw As Boolean
          
    If DstPictureBox.AutoRedraw = False Then
        blnAutoRedraw = True
        DstPictureBox.AutoRedraw = True
    End If
    
    If blnTransparent = False Then
        StretchDIBits DstPictureBox.hDC, X, Y, bm.bmWidth, bm.bmHeight, 0, 0, _
            bm.bmWidth, bm.bmHeight, ImageData(0, 0), bmi, 0, vbSrcCopy
    Else
        StretchDIBits DstPictureBox.hDC, X, Y, bm.bmWidth, bm.bmHeight, 0, 0, _
            bm.bmWidth, bm.bmHeight, ImageData(0, 0), bmi, 0, vbSrcInvert
        StretchDIBits DstPictureBox.hDC, X, Y, bm.bmWidth, bm.bmHeight, 0, 0, _
            bm.bmWidth, bm.bmHeight, ImageDataMask(0, 0), bmi, 0, vbSrcAnd
        StretchDIBits DstPictureBox.hDC, X, Y, bm.bmWidth, bm.bmHeight, 0, 0, _
            bm.bmWidth, bm.bmHeight, ImageData(0, 0), bmi, 0, vbSrcInvert
    End If
        
    'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
    'Note: always keep AutoRedraw as 'True' when using DIB sections.
    'Otherwise, you WILL get unpredictable results.
    DstPictureBox.Picture = DstPictureBox.Image
    If blnAutoRedraw = True Then DstPictureBox.AutoRedraw = False
End Sub

Public Property Get Transparent() As Boolean
    Transparent = blnTransparent
End Property

Public Property Let Transparent(ByVal vNewValue As Boolean)
    Dim RWhite As Byte
    Dim GWhite As Byte
    Dim BWhite As Byte
    Dim RBlack As Byte
    Dim GBlack As Byte
    Dim BBlack As Byte
    blnTransparent = vNewValue
    
    If blnTransparent = True Then
        ReDim ImageDataMask(0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
        RWhite = vbWhite And &HFF&
        GWhite = (vbWhite And &HFF00&) \ &H100&
        BWhite = (vbWhite And &HFF0000) \ &H10000
        RBlack = vbBlack And &HFF&
        GBlack = (vbBlack And &HFF00&) \ &H100&
        BBlack = (vbBlack And &HFF0000) \ &H10000
        
        For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 3 Step 3
            For Y = 0 To bm.bmHeight - 1
                If ImageData(X + 2, Y) = ImageData(2, 0) And ImageData(X + 1, Y) = ImageData(1, 0) And ImageData(X, Y) = ImageData(0, 0) Then
                    ImageDataMask(X + 2, Y) = RWhite
                    ImageDataMask(X + 1, Y) = GWhite
                    ImageDataMask(X, Y) = BWhite
                Else
                    ImageDataMask(X + 2, Y) = RBlack
                    ImageDataMask(X + 1, Y) = GBlack
                    ImageDataMask(X, Y) = BBlack
                End If
            Next Y
        Next X
    End If
End Property

Public Property Get Width() As Long
    Width = bmi.bmHeader.bmWidth
End Property

Public Property Get Height() As Long
    Height = bmi.bmHeader.bmHeight
End Property


Public Property Get BackColor() As Long
    BackColor = lngBackColor
End Property

Public Property Let BackColor(ByVal vNewValue As Long)
    Dim R As Long
    Dim G As Long
    Dim B As Long
    
    'If vNewValue  lngBackColor Then
        lngBackColor = vNewValue
        R = lngBackColor And 255
        G = (lngBackColor And 65535) \ 256
        B = (lngBackColor And &HFF0000) \ 65536
               
        For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 3 Step 3
            For Y = 0 To bm.bmHeight - 1
                If ImageData(X + 2, Y) = ImageData(2, 0) And ImageData(X + 1, Y) = ImageData(1, 0) And ImageData(X, Y) = ImageData(0, 0) Then
                    ImageData(X + 2, Y) = R
                    ImageData(X + 1, Y) = G
                    ImageData(X, Y) = B
                End If
            Next Y
        Next X
    'End If
    'Debug.Print bm.bmWidth
End Property

Private Type Color
    Red As Long
    Green As Long
    Blue As Long
    Alpha As Long
End Type

Private Function ByteAlignOnWord(ByVal bitDepth As Byte, ByVal Width As Long) As Long
    ' function to align any bit depth on dWord boundaries
    ByteAlignOnWord = (((Width * bitDepth) + &H1F&) And Not &H1F&) \ &H8&
End Function

Private Function RGBValues(ByVal Color As Long) As Color 'find the rgb color values of a color
    Dim ReturnColor As Color
    With ReturnColor
        .Red = Color And 255
        .Green = (Color And 65535) / 256
        .Blue = (Color And &HFF0000) \ 65536
        .Alpha = ((Color And &HFF000000) \ 16777216) And &HFF
    End With
    RGBValues = ReturnColor
End Function

Public Property Get BackColor() As Long
    BackColor = lngBackColor
End Property

Public Property Let BackColor(ByVal vNewValue As Long)
    Dim clrBackColor As Color
    Dim clrOldBackColor As Color
    
    If vNewValue <> lngBackColor Then
        clrOldBackColor = RGBValues(lngBackColor)
        lngBackColor = vNewValue
        clrBackColor = RGBValues(lngBackColor)
        For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 3 Step 3
            For Y = 0 To bm.bmHeight - 1
                If ImageData(X + 2, Y) = clrOldBackColor.Red And ImageData(X + 1, Y) = clrOldBackColor.Green And ImageData(X, Y) = clrOldBackColor.Blue Then
                    ImageData(X + 2, Y) = clrBackColor.Red
                    ImageData(X + 1, Y) = clrBackColor.Green
                    ImageData(X, Y) = clrBackColor.Blue
                End If
            Next Y
        Next X
    End If
End Property