VB Code:
'in the module:
Option Explicit
Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
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
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
Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public pic() As Byte
Public sa As SAFEARRAY2D
Public bmp As BITMAP
Public r As Long, g As Long, b As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'on the form:
Private Sub Command1_Click()
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(pic), VarPtrArray(sa), 4
For i = 0 To UBound(pic, 1) - 3 Step 3
For j = 0 To UBound(pic, 2)
r = pic(i + 2, j)
g = pic(i + 1, j)
b = pic(i, j)
r = ((g * b) \ 128)
g = ((r * b) \ 128)
b = ((r * g) \ 128)
If r > 255 Then r = 255
If r < 0 Then r = 0
If g > 255 Then g = 255
If g < 0 Then g = 0
If b > 255 Then b = 255
If b < 0 Then b = 0
pic(i, j) = b
pic(i + 1, j) = g
pic(i + 2, j) = r
Next j
Next i
CopyMemory ByVal VarPtrArray(pic), 0&, 4
Picture1.Refresh
End Sub
when i compile it says