' 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


Different Types of Data Models Explained with Examples
In the modern world, data is everything and everywhere. With so much access to technology, data has become a valuable resource for any business. Albeit a complex one. Data is