'These are the declarations you need to put before every other sub
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 0) As SAFEARRAYBOUND
End Type
Private Type SAFEARRAY2D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
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
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
'This will extract an array from the picture property of a picturebox
' these are used to address the pixel using matrices
Dim pict() As Byte
Dim sa As SAFEARRAY2D, bmp As BITMAP
' get bitmap info
GetObjectAPI Pictbox.Picture, Len(bmp), bmp 'dest
' exit if not a supported bitmap
If bmp.bmBitsPixel <> 24 Then
MsgBox " 24-bit bitmaps only", vbCritical
Exit Sub
End If
' have the local matrix point to bitmap pixels
With sa
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = bmp.bmHeight
.Bounds(1).lLbound = 0
.Bounds(1).cElements = bmp.bmWidthBytes
.pvData = bmp.bmBits
End With
CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4
'Here's where you manipulate the array! The RGB values of each pixel are by order in the X, so you'd have to use this:
For Y = 0 to UBound(pict,2)
For X = 0 to UBound(pict,1) Step 3
'This is the red value
pict(X+2,Y) = ...
'The green value
pict(X+1,Y) = ...
'The blue value
pict(X,Y) = ...
Next X
Next Y
'This is necessary, or VB will destroy your array and you'll get errors!
' clear the temporary array descriptor
' without destroying the local temporary array
CopyMemory ByVal VarPtrArray(pict), 0&, 4