Attribute VB_Name = "GetDIBBits"
'Types
    Private Type tBitmapInfoHeader
        Size As Long
        W As Long
        H As Long
        Planes As Integer
        ColorDepth As Integer
        Compression As Long
        SizeImage As Long
        xPPM As Long
        yPPM As Long
        UsedColosr As Long
        ImportantColors As Long
    End Type
    
    Private Type tColorRGBA
        B As Byte
        G As Byte
        R As Byte
        A As Byte
    End Type
    
    Private Type tBitmap
        Type As Long
        W As Long
        H As Long
        WidthBytes As Long
        Planes As Integer
        ColorDepth As Integer
        Bits As Long
    End Type
    
    Private Type tBitmapInfo
        Header As tBitmapInfoHeader
        Colors As tColorRGBA
    End Type

'Declares
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal iDC As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal iDC As Long) As Long
    
    Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal Object As Long, _
        ByVal Count As Long, Target As Any) As Long
    
    Private Declare Function GetDIBits Lib "gdi32" (ByVal iDC As Long, ByVal iBitmap As Long, _
        ByVal iStartScan As Long, ByVal iNumScans As Long, iBits As Any, iBitmapInfo As tBitmapInfo, _
        ByVal iUsage As Long) As Long
    Private Declare Function SetDIBits Lib "gdi32" (ByVal iDC As Long, ByVal iBitmap As Long, _
        ByVal iStartScan As Long, ByVal iNumScans As Long, iBits As Any, iBitmapInfo As tBitmapInfo, _
        ByVal iUsage As Long) As Long

'SetDIBPixel
    Dim Temp As Long
    Dim Data() As tColorRGBA
    
    Dim TempBitmapInfo As tBitmapInfo
    Dim TempBitmap As tBitmap
    Dim TempDC As Long
'/SetDIBPixel


Public Sub ConvertMask(ByVal iSourceDC As Long, ByVal iSourceHandle As Long)
    Dim A As Long
    
    'Get DC and attach to target
    TempDC = CreateCompatibleDC(iSourceDC)
    GetObjectAPI iSourceHandle, Len(TempBitmap), TempBitmap
    
    'Setup bitmap info
    With TempBitmapInfo.Header
        'Internal setup
        .ColorDepth = TempBitmap.ColorDepth
        .Planes = TempBitmap.Planes
        .Size = 40
        
        'Get size
        .W = TempBitmap.W
        .H = TempBitmap.H
        
        'Create data buffer
        ReDim Data((.W * .H) - 1)
    End With
    
    'Get bitmap data (note that it's top-down)
    GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0

    'Edit data
    For A = 0 To UBound(Data)
        With Data(A)
            'Check pixel color
            If .R = 255 And .G = 255 And .B = 255 Then
                'It was white -> set it to black
                .R = 0
                .G = 0
                .B = 0
            Else
                'It was not white -> set it to white
                .R = 255
                .G = 255
                .B = 255
            End If
        End With
    Next



    'not needed
    'Get position (X = 5, Y = 10)
    'Temp = (TempBitmap.H - 10) * TempBitmap.W + 5
    
    'Set a blue pixel there
    'Data(Temp).R = 0
    'Data(Temp).G = 0
    'Data(Temp).B = 255
    '/not needed
    
    'Write data back
    SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
    
    'Release DC from target
    DeleteDC TempDC
End Sub

Public Sub Brightness(ByVal iSourceDC As Long, ByVal iSourceHandle As Long, Value As Integer)
    Dim A As Long
    
    'Get DC and attach to target
    TempDC = CreateCompatibleDC(iSourceDC)
    GetObjectAPI iSourceHandle, Len(TempBitmap), TempBitmap
    
    'Setup bitmap info
    With TempBitmapInfo.Header
        'Internal setup
        .ColorDepth = TempBitmap.ColorDepth
        .Planes = TempBitmap.Planes
        .Size = 40
        
        'Get size
        .W = TempBitmap.W
        .H = TempBitmap.H
        
        'Create data buffer
        ReDim Data((.W * .H) - 1)
    End With
    
    'Get bitmap data (note that it's top-down)
    GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0

    'Edit data
    For A = 0 To UBound(Data)
        With Data(A)
            'Check pixel color
            If .R + Value > 255 Then
                .R = 255
            ElseIf .R + Value < 0 Then
                .R = 0
            Else
                .R = .R + Value
            End If
            
            If .G + Value > 255 Then
                .G = 255
            ElseIf .G + Value < 0 Then
                .G = 0
            Else
                .G = .G + Value
            End If
            
            If .B + Value > 255 Then
                .B = 255
            ElseIf .B + Value < 0 Then
                .B = 0
            Else
                .B = .B + Value
            End If
            
        End With
    Next

    'Write data back
    SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
    
    'Release DC from target
    DeleteDC TempDC
End Sub
    

Public Sub ColorShade(ByVal iSourceDC As Long, ByVal iSourceHandle As Long, ValuePercent As Integer, Color As Long)
    Dim A As Long
    
    'Get DC and attach to target
    TempDC = CreateCompatibleDC(iSourceDC)
    GetObjectAPI iSourceHandle, Len(TempBitmap), TempBitmap
    
    'Setup bitmap info
    With TempBitmapInfo.Header
        'Internal setup
        .ColorDepth = TempBitmap.ColorDepth
        .Planes = TempBitmap.Planes
        .Size = 40
        
        'Get size
        .W = TempBitmap.W
        .H = TempBitmap.H
        
        'Create data buffer
        ReDim Data((.W * .H) - 1)
    End With
    
    'Get bitmap data (note that it's top-down)
    GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0

    'Edit data
    
    Dim ToRed As Single
    Dim ToGreen As Single
    Dim ToBlue As Single
    
    ToRed = Color And 255
    ToGreen = (Color And 65280) \ 256
    ToBlue = (Color And 16711680) \ 65535
    
    For A = 0 To UBound(Data)
        With Data(A)
            'Check pixel color
            If .R * (1 - ValuePercent) + ToRed * ValuePercent > 255 Then
                .R = 255
            ElseIf .R * (1 - ValuePercent) + ToRed * ValuePercent < 0 Then
                .R = 0
            Else
                .R = .R * (1 - ValuePercent) + ToRed * ValuePercent
            End If
            
            If .G * (1 - ValuePercent) + ToGreen * ValuePercent > 255 Then
                .G = 255
            ElseIf .G * (1 - ValuePercent) + ToGreen * ValuePercent < 0 Then
                .G = 0
            Else
                .G = .G * (1 - ValuePercent) + ToGreen * ValuePercent
            End If
            
            If .B * (1 - ValuePercent) + ToBlue * ValuePercent > 255 Then
                .B = 255
            ElseIf .B * (1 - ValuePercent) + ToBlue * ValuePercent < 0 Then
                .B = 0
            Else
                .B = .B * (1 - ValuePercent) + ToBlue * ValuePercent
            End If
            
        End With
    Next

    'Write data back
    SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
    
    'Release DC from target
    DeleteDC TempDC
End Sub

Public Sub ColorShadeSection(ByVal iSourceDC As Long, ByVal iSourceHandle As Long, FromX As Single, FromY As Single, ToX As Single, ToY As Single, ValuePercent As Integer, Color As Long)
    Dim X As Long
    Dim Y As Long
    
    'Get DC and attach to target
    TempDC = CreateCompatibleDC(iSourceDC)
    GetObjectAPI iSourceHandle, Len(TempBitmap), TempBitmap
    
    'Setup bitmap info
    With TempBitmapInfo.Header
        'Internal setup
        .ColorDepth = TempBitmap.ColorDepth
        .Planes = TempBitmap.Planes
        .Size = 40
        
        'Get size
        .W = TempBitmap.W
        .H = TempBitmap.H
        
        'Create data buffer
        ReDim Data((.W * .H) - 1)
    End With
    
    'Get bitmap data (note that it's top-down)
    GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0

    'Edit data
    
    Dim TempXY As Single
    
    If ToY < FromY Then
        TempXY = ToY
        ToY = FromY
        FromY = TempXY
    End If
    
    If ToX < FromX Then
        TempXY = ToX
        ToX = FromX
        FromX = TempXY
    End If
    
    Dim ToRed As Single
    Dim ToGreen As Single
    Dim ToBlue As Single
    
    ToRed = Color And 255
    ToGreen = (Color And 65280) \ 256
    ToBlue = (Color And 16711680) \ 65535
    
    For Y = (TempBitmap.H - ToY) * TempBitmap.W To (TempBitmap.H - FromY) * TempBitmap.W Step TempBitmap.W
        For X = FromX To ToX
            If X + Y > 0 And X + Y <= UBound(Data) Then
                With Data(X + Y)
                    'Check pixel color
                    If .R * (1 - ValuePercent) + ToRed * ValuePercent > 255 Then
                        .R = 255
                    ElseIf .R * (1 - ValuePercent) + ToRed * ValuePercent < 0 Then
                        .R = 0
                    Else
                        .R = .R * (1 - ValuePercent) + ToRed * ValuePercent
                    End If
                    
                    If .G * (1 - ValuePercent) + ToGreen * ValuePercent > 255 Then
                        .G = 255
                    ElseIf .G * (1 - ValuePercent) + ToGreen * ValuePercent < 0 Then
                        .G = 0
                    Else
                        .G = .G * (1 - ValuePercent) + ToGreen * ValuePercent
                    End If
                    
                    If .B * (1 - ValuePercent) + ToBlue * ValuePercent > 255 Then
                        .B = 255
                    ElseIf .B * (1 - ValuePercent) + ToBlue * ValuePercent < 0 Then
                        .B = 0
                    Else
                        .B = .B * (1 - ValuePercent) + ToBlue * ValuePercent
                    End If
                End With
            End If
        Next
    Next

    'Write data back
    SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
    
    'Release DC from target
    DeleteDC TempDC
End Sub


Public Sub ToColor(ByVal iSourceDC As Long, ByVal iSourceHandle As Long, ValuePercent As Single, Color As Long)
    Dim A As Long
    
    'Get DC and attach to target
    TempDC = CreateCompatibleDC(iSourceDC)
    GetObjectAPI iSourceHandle, Len(TempBitmap), TempBitmap
    
    'Setup bitmap info
    With TempBitmapInfo.Header
        'Internal setup
        .ColorDepth = TempBitmap.ColorDepth
        .Planes = TempBitmap.Planes
        .Size = 40
        
        'Get size
        .W = TempBitmap.W
        .H = TempBitmap.H
        
        'Create data buffer
        ReDim Data((.W * .H) - 1)
    End With
    
    'Get bitmap data (note that it's top-down)
    GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0

    'Edit data
    
    Dim ToRed As Single
    Dim ToGreen As Single
    Dim ToBlue As Single
    
    ToRed = Color And 255
    ToGreen = (Color And 65280) \ 256
    ToBlue = (Color And 16711680) \ 65535
    
    ValuePercent = (ValuePercent / 100)
    
    For A = 0 To UBound(Data)
        With Data(A)
            'Check pixel color
            If .R * (1 - ValuePercent) + ToRed * ValuePercent > 255 Then
                .R = 255
            ElseIf .R * (1 - ValuePercent) + ToRed * ValuePercent < 0 Then
                .R = 0
            Else
                .R = .R * (1 - ValuePercent) + ToRed * ValuePercent
            End If
            
            If .G * (1 - ValuePercent) + ToGreen * ValuePercent > 255 Then
                .G = 255
            ElseIf .G * (1 - ValuePercent) + ToGreen * ValuePercent < 0 Then
                .G = 0
            Else
                .G = .G * (1 - ValuePercent) + ToGreen * ValuePercent
            End If
            
            If .B * (1 - ValuePercent) + ToBlue * ValuePercent > 255 Then
                .B = 255
            ElseIf .B * (1 - ValuePercent) + ToBlue * ValuePercent < 0 Then
                .B = 0
            Else
                .B = .B * (1 - ValuePercent) + ToBlue * ValuePercent
            End If
            
        End With
    Next

    'Write data back
    SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
    
    'Release DC from target
    DeleteDC TempDC
End Sub

Public Sub ToColorSection(ByVal iSourceDC As Long, ByVal iSourceHandle As Long, FromX As Single, FromY As Single, ToX As Single, ToY As Single, ValuePercent As Single, Color As Long)
    Dim X As Long
    Dim Y As Long
    
    'Get DC and attach to target
    TempDC = CreateCompatibleDC(iSourceDC)
    GetObjectAPI iSourceHandle, Len(TempBitmap), TempBitmap
    
    'Setup bitmap info
    With TempBitmapInfo.Header
        'Internal setup
        .ColorDepth = TempBitmap.ColorDepth
        .Planes = TempBitmap.Planes
        .Size = 40
        
        'Get size
        .W = TempBitmap.W
        .H = TempBitmap.H
        
        'Create data buffer
        ReDim Data((.W * .H) - 1)
    End With
    
    'Get bitmap data (note that it's top-down)
    GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0

    'Edit data
    
    Dim TempXY As Single
    
    If ToY < FromY Then
        TempXY = ToY
        ToY = FromY
        FromY = TempXY
    End If
    
    If ToX < FromX Then
        TempXY = ToX
        ToX = FromX
        FromX = TempXY
    End If
    
    Dim ToRed As Single
    Dim ToGreen As Single
    Dim ToBlue As Single
    
    ToRed = Color And 255
    ToGreen = (Color And 65280) \ 256
    ToBlue = (Color And 16711680) \ 65535
    
    ValuePercent = (ValuePercent / 100)
    
    For Y = (TempBitmap.H - ToY) * TempBitmap.W To (TempBitmap.H - FromY) * TempBitmap.W Step TempBitmap.W
        For X = FromX To ToX
            If X + Y > 0 And X + Y <= UBound(Data) Then
                With Data(X + Y)
                    'Check pixel color
                    If .R * (1 - ValuePercent) + ToRed * ValuePercent > 255 Then
                        .R = 255
                    ElseIf .R * (1 - ValuePercent) + ToRed * ValuePercent < 0 Then
                        .R = 0
                    Else
                        .R = .R * (1 - ValuePercent) + ToRed * ValuePercent
                    End If
                    
                    If .G * (1 - ValuePercent) + ToGreen * ValuePercent > 255 Then
                        .G = 255
                    ElseIf .G * (1 - ValuePercent) + ToGreen * ValuePercent < 0 Then
                        .G = 0
                    Else
                        .G = .G * (1 - ValuePercent) + ToGreen * ValuePercent
                    End If
                    
                    If .B * (1 - ValuePercent) + ToBlue * ValuePercent > 255 Then
                        .B = 255
                    ElseIf .B * (1 - ValuePercent) + ToBlue * ValuePercent < 0 Then
                        .B = 0
                    Else
                        .B = .B * (1 - ValuePercent) + ToBlue * ValuePercent
                    End If
                End With
            End If
        Next
    Next

    'Write data back
    SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
    
    'Release DC from target
    DeleteDC TempDC
End Sub

Public Sub BrightnessSection(ByVal iSourceDC As Long, ByVal iSourceHandle As Long, Value As Integer, FromX As Single, FromY As Single, ToX As Single, ToY As Single)
    Dim X As Long
    Dim Y As Long
    
    'Get DC and attach to target
    TempDC = CreateCompatibleDC(iSourceDC)
    GetObjectAPI iSourceHandle, Len(TempBitmap), TempBitmap
    
    'Setup bitmap info
    With TempBitmapInfo.Header
        'Internal setup
        .ColorDepth = TempBitmap.ColorDepth
        .Planes = TempBitmap.Planes
        .Size = 40
        
        'Get size
        .W = TempBitmap.W
        .H = TempBitmap.H
        
        'Create data buffer
        ReDim Data((.W * .H) - 1)
    End With
    
    'Get bitmap data (note that it's top-down)
    GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0

    'For A = ToY * TempBitmap.W + ToX To (TempBitmap.H - FromY) * TempBitmap.W + FromX
    
    Dim TempXY As Single
    
    If ToY < FromY Then
        TempXY = ToY
        ToY = FromY
        FromY = TempXY
    End If
    
    If ToX < FromX Then
        TempXY = ToX
        ToX = FromX
        FromX = TempXY
    End If
    
    For Y = (TempBitmap.H - ToY) * TempBitmap.W To (TempBitmap.H - FromY) * TempBitmap.W Step TempBitmap.W
        For X = FromX To ToX
            If X + Y > 0 And X + Y <= UBound(Data) Then
                With Data(X + Y)
                    'Check pixel color
                    If .R + Value > 255 Then
                        .R = 255
                    ElseIf .R + Value < 0 Then
                        .R = 0
                    Else
                        .R = .R + Value
                    End If
                    
                    If .G + Value > 255 Then
                        .G = 255
                    ElseIf .G + Value < 0 Then
                        .G = 0
                    Else
                        .G = .G + Value
                    End If
                    
                    If .B + Value > 255 Then
                        .B = 255
                    ElseIf .B + Value < 0 Then
                        .B = 0
                    Else
                        .B = .B + Value
                    End If
                End With
            End If
        Next
    Next

    'Write data back
    SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
    
    'Release DC from target
    DeleteDC TempDC
End Sub
    
Public Sub InitSetDIBPixel(ByVal iSourceDC As Long, ByVal iSourceHandle As Long)

    
    'Get DC and attach to target
    TempDC = CreateCompatibleDC(iSourceDC)
    GetObjectAPI iSourceHandle, Len(TempBitmap), TempBitmap
    
    'Setup bitmap info
    With TempBitmapInfo.Header
        'Internal setup
        .ColorDepth = TempBitmap.ColorDepth
        .Planes = TempBitmap.Planes
        .Size = 40
        
        'Get size
        .W = TempBitmap.W
        .H = TempBitmap.H
        
        'Create data buffer
        ReDim Data((.W * .H) - 1)
    End With
    
    'Get bitmap data (note that it's top-down)
    GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
End Sub

Public Sub SetDIBPixel(X As Single, Y As Single, Red As Single, Green As Single, Blue As Single)

    With Data((TempBitmap.H - Y) * TempBitmap.W + X)
        'Check pixel color
        If Red > 255 Then
            .R = 255
        ElseIf Red < 0 Then
            .R = 0
        Else
            .R = Red
        End If
        
        If Green > 255 Then
            .G = 255
        ElseIf Green < 0 Then
            .G = 0
        Else
            .G = Green
        End If
        
        If Blue > 255 Then
            .B = 255
        ElseIf Blue < 0 Then
            .B = 0
        Else
            .B = Blue
        End If
    End With
End Sub

Public Function GetDIBPixel(X As Single, Y As Single) As Long
    With Data((TempBitmap.H - Y) * TempBitmap.W + X)
        GetDIBPixel = RGB(.R, .G, .B)
    End With
End Function

Public Function GetDIBPixelR(X As Single, Y As Single) As Long
    With Data((TempBitmap.H - Y) * TempBitmap.W + X)
        GetDIBPixelR = .R
    End With
End Function

Public Function GetDIBPixelG(X As Single, Y As Single) As Long
    With Data((TempBitmap.H - Y) * TempBitmap.W + X)
        GetDIBPixelG = .G
    End With
End Function

Public Function GetDIBPixelB(X As Single, Y As Single) As Long
    With Data((TempBitmap.H - Y) * TempBitmap.W + X)
        GetDIBPixelB = .B
    End With
End Function

Public Sub FinishSetDIBPixel(ByVal iSourceDC As Long, ByVal iSourceHandle As Long)

    'Write data back
    SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
    
    'Release DC from target
    DeleteDC TempDC
End Sub

    
Public Sub BlackWhite(ByVal iSourceDC As Long, ByVal iSourceHandle As Long)
    Dim A As Long
    
    'Get DC and attach to target
    TempDC = CreateCompatibleDC(iSourceDC)
    GetObjectAPI iSourceHandle, Len(TempBitmap), TempBitmap
    
    'Setup bitmap info
    With TempBitmapInfo.Header
        'Internal setup
        .ColorDepth = TempBitmap.ColorDepth
        .Planes = TempBitmap.Planes
        .Size = 40
        
        'Get size
        .W = TempBitmap.W
        .H = TempBitmap.H
        
        'Create data buffer
        ReDim Data((.W * .H) - 1)
    End With
    
    'Get bitmap data (note that it's top-down)
    GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0

    'Edit data
    
    Dim Color As Long
    
    For A = 0 To UBound(Data)
        With Data(A)
            'Check pixel color
            
            Color = .R + .G + .B
            Color = Color / 3
            Color = Round(Color)
            
            If Color > 127 Then
                .R = 255
                .G = 255
                .B = 255
            ElseIf Color < 128 Then
                .R = 0
                .G = 0
                .B = 0
            End If
        End With
    Next

    'Write data back
    SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data(0), TempBitmapInfo, 0
    
    'Release DC from target
    DeleteDC TempDC
End Sub
    
    

