i have read several toturials and the autors don't explaint the very important thing:(
i understand that the pointers use BRG instead RGB. ok, but how can i compare the colors?
my problem is here:
because that if isn't used... and i have sure that oldcolor realy exists:(
so can anyone advice me?
(i'm trying these, because i need more speed that DIB's)
i understand that the pointers use BRG instead RGB. ok, but how can i compare the colors?
Code:
Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
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
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 Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Sub ChangeColor(Picture As StdPicture, OldColor As Long, NewColor 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 r2 As Long, g2 As Long, b2 As Long
Dim X As Long, Y As Long
GetObjectAPI 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), VarPtr(sa), 4
For Y = 0 To UBound(pic, 2)
For X = 0 To UBound(pic, 1) Step 3
r = pic(X + 2, Y)
g = pic(X + 1, Y)
b = pic(X, Y)
If RGB(b, g, r) = OldColor Then
r2 = NewColor And 255
b2 = (NewColor And &HFF0000) \ 65536
g2 = (NewColor And 65535) \ 256
pic(X + 2, Y) = b2
pic(X + 1, Y) = g2
pic(X, Y) = r2
End If
Next X
Next Y
CopyMemory ByVal VarPtrArray(pic), 0&, 4
End Sub
Private Sub Command1_Click()
'TransparentAlphaBlend Picture1.Picture, Picture2.Picture, CByte(Text1.Text)
ChangeColor Picture1.Picture, Picture3.BackColor, Picture4.BackColor
Picture1.Refresh
End SubCode:
For Y = 0 To UBound(pic, 2)
For X = 0 To UBound(pic, 1) Step 3
r = pic(X + 2, Y)
g = pic(X + 1, Y)
b = pic(X, Y)
If RGB(b, g, r) = OldColor Then
r2 = NewColor And 255
b2 = (NewColor And &HFF0000) \ 65536
g2 = (NewColor And 65535) \ 256
pic(X + 2, Y) = b2
pic(X + 1, Y) = g2
pic(X, Y) = r2
End If
Next X
Next Yso can anyone advice me?
(i'm trying these, because i need more speed that DIB's)