Option Explicit
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
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 Type BITMAP '14 bytes
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 VarPtrArray Lib "msvbvm60.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 Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Dim pic() As Byte
Dim sa As SAFEARRAY2D
Dim bmp As BITMAP
Dim r As Long, g As Long, b As Long
Dim i As Integer, j As Integer
Dim picFileName As String
Dim picOrig As StdPicture
Private Sub Command1_Click()
dlg1.FileName = ""
dlg1.Flags = &H1000& Or &H4&
dlg1.ShowOpen
If dlg1.FileName <> "" Then
picFileName = dlg1.FileName
Picture1.Picture = LoadPicture(picFileName)
Set picOrig = Picture1.Picture
End If
End Sub
Private Sub Command2_Click()
dlg1.Flags = &H2
dlg1.ShowColor
selectedColor.BackColor = dlg1.Color
End Sub
Private Sub Command3_Click()
If picOrig <> 0 Then
Set Picture1.Picture = picOrig
End If
End Sub
Private Sub Command4_Click()
GetObjectAPI Picture1.Picture, Len(bmp), bmp
sa.cbElements = 1
sa.cDims = 2
sa.Bounds(0).lLbound = 0
sa.Bounds(0).cElements = bmp.bmHeight
sa.Bounds(1).lLbound = 0
sa.Bounds(1).cElements = bmp.bmWidthBytes
sa.pvData = bmp.bmBits
CopyMemory ByVal VarPtrArray(pic), VarPtrArray(sa), 4
For i = 0 To UBound(pic, 1) - 3 Step 3
For j = 0 To UBound(pic, 2)
pic(i, j) = 255 - pic(i, j)
Next j
Next i
CopyMemory ByVal VarPtrArray(pic), 0&, 4 'delete array
Picture1.Refresh
End Sub