ok, my full code:
Code:
-from form1-
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
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Dim pic() As Byte
Dim sa As SAFEARRAY2D
Dim bmp As BITMAP
Dim r As Long, g As Long, b As Long, i As Long, j As Long
Private Sub Command1_Click()
GetObjectAPI Picture1.Picture, Len(bmp), bmp
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
End Sub
Private Sub Command2_Click()
'invert image
For i = 0 To UBound(pic, 1)
For j = 0 To UBound(pic, 2)
pic(i, j) = 255 - pic(i, j)
Next j
Next i
End Sub
Private Sub Command3_Click()
'change colors seprately
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
End Sub
Private Sub Command4_Click()
'Command4.Caption = RBG(pic(0, 2), pic(0, 1), pic(0, 0))
End Sub
Private Sub Command5_Click()
CopyMemory ByVal VarPtrArray(pic), 0&, 4
'You should delete your array after your changes, like in the line shown above.
Picture1.Refresh
End Sub
Private Sub Form_Load()
Set Picture1.Picture = LoadPicture("c:\circ.bmp")
End Sub
-from module1-
Option Explicit
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
ok, when i declare sa as:
Code:
Dim sa() As SAFEARRAY2D
width sa throws out an error - must use user defined type, object, or variant
when i change width to
Code:
'With sa
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
'End With
i get invalid qualifier error
with
Code:
Dim sa(3) As SAFEARRAY2D
i modified width to
Code:
With sa(0)
.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
and left
Code:
CopyMemory ByVal VarPtrArray(pic), VarPtrArray(sa), 4
as is. When command1_click is run, no errors result, but command2_click (run after command1_click is run) causes a crash of vb (windows xp style must close program, send or dont send info to microsoft...)
im wondering if the variables need an overhaul in this example. It seems that the intent of this was to have:
Code:
dim pix(0 To bmp.bmHeight, 0 To bmp.bmWidthBytes) As Byte
'pix(0,0)=red pix (0,1) = blue pix (0,2) = green
a seperate 255 byte for each color value on the bitmap, so in theory this would remove the need to convert each color from 3x 255 values into hex format (which would otherwise be converted into long for a vb color change useing .pset or setpixel) and display the changes, but the above code would need 2 nested for...next loops to transfer from picture1.picture to the variables (plus conversion code from a single long to 3 bytes) and that part seems to be done with this code:
Code:
.pvData = bmp.bmBits
which should be faster, is the tutorial is to be believed:
Quote:
This method allows really fast pixel manipulation, that could also be used for games.
I also created a table to show you the speed differences. The picture was 433 by 263 pixels large and has been inverted every time. My PC is a P2 MMX at 300 MHz and 96 MB RAM. Every test has been repeated five times. Then I calculated a middle of all the five tests, and here they are:
PSet and Point 3737,6 ms
GetPixel and SetPixel 3133,4 ms
GetPixel and SetPixelV 3210,4 ms
GetPixel and SetPixel with created DC 2032,4 ms
GetPixel and SetPixelV with created DC 1936,0 ms
Pointer 222,0 ms
As you can see, the 'Pointer' method a lot faster than any other. That's why you should use it, when ever you need pixel plotting in you programs.
Login
Register
FAQ
Search
