Option Explicit

Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors(1) As RGBQUAD
End Type

Public Const SRCCOPY = &HCC0020

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

Declare Function CreateDIBitmap Lib "gdi32" (ByVal hdc As Long, _
   lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits _
   As Any, lpInitInfo As BITMAPINFO, ByVal wUsage As Long) As Long
   
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
   ByVal nWidth As Long, ByVal nHeight As Long) As Long
   
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) _
   As Long
   
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal _
   hObject As Long) As Long
   
Declare Function GetDIBits Lib "gdi32" (ByVal aHDC 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
   
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 _
   dwRop As Long) As Long
   
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Declare Function SetDIBits 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

'Array layout is:
'
'  Bits(0 To 2, 0 To cX - 1, 0 To cY - 1) As Byte
'
'The First dimension represents the color:
'  0 is Blue
'  1 is Green
'  2 is Red

Public Function Bounds(ByVal nNumber As Long) As Long
    
    Do While ((nNumber) * 3) / 4 <> ((nNumber) * 3) \ 4
        nNumber = nNumber + 1
    Loop
    
    Bounds = nNumber

End Function

'Copies an Array of color information to an hDC.  Expects the array to
' be Bits(0 To 2, 0 To cX - 1, 0 To cY - 1), and cX needs to be run
' through Bounds first to make sure it ends on a word boundry

Public Sub SetBits(X As Long, Y As Long, cX As Long, cY As Long, Bits() _
   As Byte, hDCWindow As Long)
    
    Dim hdcWinCopy As Long
    Dim hbitmapWinCopy As Long
    Dim hbitmapWinCopyOld As Long
    Dim sBitmapBits As String
    Dim hdibCopy As Long
    Dim bi As BITMAPINFO
    
    'Create the DIB
    bi.bmiHeader.biSize = 40
    bi.bmiHeader.biWidth = cX
    bi.bmiHeader.biHeight = cY
    bi.bmiHeader.biPlanes = 1
    bi.bmiHeader.biBitCount = 24
    bi.bmiHeader.biCompression = 0
    bi.bmiHeader.biSizeImage = 0
    bi.bmiHeader.biXPelsPerMeter = 0
    bi.bmiHeader.biYPelsPerMeter = 0
    bi.bmiHeader.biClrImportant = 1
    bi.bmiHeader.biClrUsed = 0

    hdibCopy = CreateDIBitmap(hDCWindow, bi.bmiHeader, 4, _
               Bits(0, 0, 0), bi, 0)

    'Craete a DC to copy the window to
    hdcWinCopy = CreateCompatibleDC(hDCWindow)
    hbitmapWinCopy = CreateCompatibleBitmap(hDCWindow, (cX), (cY))

    hbitmapWinCopyOld = SelectObject(hdcWinCopy, hbitmapWinCopy)

    'Copy the buffer to the DIB
    SetDIBits hdcWinCopy, hbitmapWinCopy, 0, cY, Bits(0, 0, 0), bi, 0
    BitBlt hDCWindow, X, Y, cX, cY, hdcWinCopy, 0, 0, SRCCOPY

    'Delete the buffer
    SelectObject hdcWinCopy, hbitmapWinCopyOld
    DeleteObject hbitmapWinCopy
    DeleteDC hdcWinCopy

    DeleteObject hdibCopy

End Sub

'Copies an hDC to an Array.  Expects the array to be Bits(0 To 2,
' 0 To cX - 1, 0 To cY - 1), and cX needs to be run through Bounds
' first to make sure it ends on a word boundry

Public Sub CopyBits(X As Long, Y As Long, cX As Long, cY As Long, _
  Bits() As Byte, hDCWindow As Long)
    
    Dim hdcWinCopy As Long
    Dim hbitmapWinCopy As Long
    Dim hbitmapWinCopyOld As Long
    Dim sBitmapBits As String
    Dim hdibCopy As Long
    Dim bi As BITMAPINFO
    
    'Create the DIB
    bi.bmiHeader.biSize = 40
    bi.bmiHeader.biWidth = cX
    bi.bmiHeader.biHeight = cY
    bi.bmiHeader.biPlanes = 1
    bi.bmiHeader.biBitCount = 24
    bi.bmiHeader.biCompression = 0
    bi.bmiHeader.biSizeImage = 0
    bi.bmiHeader.biXPelsPerMeter = 0
    bi.bmiHeader.biYPelsPerMeter = 0
    bi.bmiHeader.biClrImportant = 1
    bi.bmiHeader.biClrUsed = 0

    hdibCopy = CreateDIBitmap(hDCWindow, bi.bmiHeader, 4, _
               Bits(0, 0, 0), bi, 0)

    'Craete a DC to copy the window to
    hdcWinCopy = CreateCompatibleDC(hDCWindow)
    hbitmapWinCopy = CreateCompatibleBitmap(hDCWindow, (cX), (cY))
    
    hbitmapWinCopyOld = SelectObject(hdcWinCopy, hbitmapWinCopy)

    'Copy the window to our buffer
    BitBlt hdcWinCopy, 0, 0, cX, cY, hDCWindow, X, Y, SRCCOPY

    'Copy the buffer to the DIB
    GetDIBits hdcWinCopy, hbitmapWinCopy, 0, cY, Bits(0, 0, 0), bi, 0

    'Delete the buffer
    SelectObject hdcWinCopy, hbitmapWinCopyOld
    DeleteObject hbitmapWinCopy
    DeleteDC hdcWinCopy

    DeleteObject hdibCopy

End Sub

    'Copies the Form's hDC into an array, manipulate that array, then
    ' copy the array back to the form

    Dim X As Long
    Dim Y As Long
    Dim cX As Long
    Dim cY As Long
    
    X = 0
    Y = 0
    cX = Bounds(Me.ScaleWidth / Screen.TwipsPerPixelX)
    cY = Me.ScaleHeight / Screen.TwipsPerPixelY
    
    Dim Bits() As Byte
    ReDim Bits(2, cX - 1, cY - 1)
    
    CopyBits X, Y, cX, cY, Bits, Me.hdc
    
    Dim nLoopX As Long
    Dim nLoopY As Long
    Dim nLoopColor As Long
    
    For nLoopX = 0 To cX - 1
        For nLoopY = 0 To cY - 1
            For nLoopColor = 0 To 2
            
                Bits(nLoopColor, nLoopX, nLoopY) = _
                  (Bits(nLoopColor, nLoopX, nLoopY) * 1.5) Mod &HFF
                  
            Next
        Next
    Next
   
    SetBits X, Y, cX, cY, Bits(), Me.hdc