SwapColors - Swap any two colors in a 256-color bitmap

' This structure holds Bitmap information
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

' This structure holds SAFEARRAY info
Private Type SafeArray2
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    cElements1 As Long
    lLbound1 As Long
    cElements2 As Long
    lLbound2 As Long
End Type

' API declares
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As _
    Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal _
    hObject As Long, ByVal nCount As Long, lpObject As Any) As Long


' Swap two colors in a PictureBox that holds a 256-color bitmap
'
' the two color arguments are the indexes of the colors to be swapper in 
' the 256 palette (must be in the range 0-255).

Sub SwapColors(pictbox As PictureBox, ByVal color1 As Integer, _
    ByVal color2 As Integer)
    ' these are used to address the pixel using matrices
    Dim pict() As Byte
    Dim sa As SafeArray2
    Dim bmp As BITMAP
    Dim r As Integer, c As Integer
    Dim value As Byte
    
    ' get bitmap info
    GetObjectAPI pictbox.Picture, Len(bmp), bmp
    ' exit if not a supported bitmap
    If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then
        MsgBox "This routine supports 256-color bitmaps only", vbCritical
        Exit Sub
    End If
    
    ' have the local matrix point to bitmap pixels
    With sa
        .cbElements = 1
        .cDims = 2
        .lLbound1 = 0
        .cElements1 = bmp.bmHeight
        .lLbound2 = 0
        .cElements2 = bmp.bmWidthBytes
        .pvData = bmp.bmBits
    End With
    CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4
    
    ' swap colors
    For r = 0 To UBound(pict, 1)
        For c = 0 To UBound(pict, 2)
            value = pict(r, c)
            If value = color1 Then
                pict(r, c) = color2
            ElseIf value = color2 Then
                pict(r, c) = color1
            End If
        Next
    Next
    
    ' destroy the local temporary array
    CopyMemory ByVal VarPtrArray(pict), 0&, 4
    
    ' inform VB that something has changed
    pictbox.Refresh
End Sub

' Support routine for SwapColors

Private Function VarPtrArray(arr As Variant) As Long
    CopyMemory VarPtrArray, ByVal VarPtr(arr) + 8, 4
End Function