SwapColorsArray – Swap all the colors in a 256-color bitmap

SwapColorsArray – Swap all the colors in a 256-color bitmap

' This structure holds Bitmap informationPrivate Type BITMAP    bmType As Long    bmWidth As Long    bmHeight As Long    bmWidthBytes As Long    bmPlanes As Integer    bmBitsPixel As Integer    bmBits As LongEnd Type' This structure holds SAFEARRAY infoPrivate 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 LongEnd Type' API declaresPrivate 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' Change all the colors in the palette with another color in the same palette.' The second argument is an array of Integers that specifies with which color' each element must be replaced. For example if newColor(1) = 4 then the color ' 1 in the' palette with be replaced with color 4.' Example:'    ' prepare an array of colors that shift the color value by one'    Dim newColors(255) As Integer'    Dim i As Integer'    For i = 0 To 255'        newColors(i) = (i + 1) Mod 256'    Next'    SwapColorsArray Picture1, newColorsSub SwapColorsArray(pictbox As PictureBox, newColors() 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 >= 0 And value <= 255 Then                pict(r, c) = newColors(value)            End If        Next    Next        ' destroy the local temporary array    CopyMemory ByVal VarPtrArray(pict), 0&, 4        ' inform VB that something has changed    pictbox.RefreshEnd Sub' Support routine for SwapColorsPrivate Function VarPtrArray(arr As Variant) As Long    CopyMemory VarPtrArray, ByVal VarPtr(arr) + 8, 4End Function

Share the Post:
Heading photo, Metadata.

What is Metadata?

What is metadata? Well, It’s an odd concept to wrap your head around. Metadata is essentially the secondary layer of data that tracks details about the “regular” data. The regular

XDR solutions

The Benefits of Using XDR Solutions

Cybercriminals constantly adapt their strategies, developing newer, more powerful, and intelligent ways to attack your network. Since security professionals must innovate as well, more conventional endpoint detection solutions have evolved

AI is revolutionizing fraud detection

How AI is Revolutionizing Fraud Detection

Artificial intelligence – commonly known as AI – means a form of technology with multiple uses. As a result, it has become extremely valuable to a number of businesses across

AI innovation

Companies Leading AI Innovation in 2023

Artificial intelligence (AI) has been transforming industries and revolutionizing business operations. AI’s potential to enhance efficiency and productivity has become crucial to many businesses. As we move into 2023, several