-
1 Attachment(s)
[RESOLVED] [VB6] API DIBs - Change Image Colors
by these page VB Graphics Programming: Part 3 (Advanced API): http://www.tannerhelland.com/vb6/vb-...programming-3/
i build a procedure for change image colors. but by some reason isn't working:(
The VB6 is closed. but it's showed a Windows error window.
error message: ".... the memory can't be read..." and "...the memory can't be writen".
heres the procedure:
Code:
Public Sub SetImageData(ByRef DstPictureBox As PictureBox, ByRef ImageData() As Byte, ByRef OldColor As Long, ByRef NewColor As Long)
Dim X As Long, Y As Long
For X = 0 To bm.bmHeight - 1
For Y = 0 To bm.bmHeight - 1
If OldColor = RGB(ImageData(2, X, Y), ImageData(1, X, Y), ImageData(0, X, Y)) Then
RGBColor = RGBValues(NewColor)
ImageData(2, X, Y) = RGBColor.Red
ImageData(1, X, Y) = RGBColor.Green
ImageData(0, X, Y) = RGBColor.Blue
End If
Next Y
Next X
'Now that we've built the temporary header, we use StretchDIBits to take the data from the ImageData() array and put it into SrcPictureBox using the settings specified in 'bmi' (the StretchDIBits call should be on one continuous line)
StretchDIBits DstPictureBox.hDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0, 0), bmi, 0, vbSrcCopy
'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
'Note: always keep AutoRedraw as 'True' when using DIB sections. Otherwise, you WILL get unpredictable results.
If DstPictureBox.AutoRedraw = True Then
DstPictureBox.Picture = DstPictureBox.Image
DstPictureBox.Refresh
End If
End Sub
Private Function RGBValues(Color As Long) As Color 'find the rgb color values of a color
Dim ReturnColor As Color
With ReturnColor
.Red = Fix(Color And 255)
.Green = Fix((Color And 65535) / 256)
.Blue = Fix(Color / 65536)
End With
RGBValues = ReturnColor
End Function
now heres the project....
i don't know why these error:(
can anyone help me fix the error?
thanks
-
Re: [VB6] API DIBs - Change Image Colors
Try it with a normal jpeg image. with bit dept 24, frame count-1.
I cannot test it right now as I don't have vb6 in the office. Can check it only when I get home...
-
Re: [VB6] API DIBs - Change Image Colors
I see a few problems
1. In your posted code above, shouldn't the For:Next loop be: For X = 0 to bm.bmWidth-1
2. In your GetImageData, routine you are sizing your array incorrectly which is probably causing the crashes. Number of bytes for each row of a bitmap must be word aligned (divisible by 4). You cannot just assume that the following statement is correct for a 24 bit bitmap. Only if the width of the bitmap is divisible by 4 will it be correct else it will not be.
Code:
' Wrong
ReDim ImageData(0 To 2, 0 To bm.bmWidth - 1, 0 To bm.bmHeight - 1)
' added this function I use to word align any bitmap bit depth
Public Function ByteAlignOnWord(ByVal bitDepth As Byte, ByVal Width As Long) As Long
' function to align any bit depth on dWord boundaries
ByteAlignOnWord = (((Width * bitDepth) + &H1F&) And Not &H1F&) \ &H8&
End Function
' now the ReDim may look like this
ReDim ImageData(0 To 2, 0 To ByteAlignOnWord(24,bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
3. In your GetImageData() routine you should verify that the following line of code does not return zero:
GetObject SrcPictureBox.Image, bmLen, bm
4. Tip: The line "RGBColor = RGBValues(NewColor)" only needs to be executed one time. I would take it out of the loop.
-
Re: [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
LaVolpe
I see a few problems
1. In your posted code above, shouldn't the For:Next loop be: For X = 0 to bm.bm
Width-1
2. In your GetImageData, routine you are sizing your array incorrectly which is probably causing the crashes. Number of bytes for each row of a bitmap must be word aligned (divisible by 4). You cannot just assume that the following statement is correct for a 24 bit bitmap. Only if the width of the bitmap is divisible by 4 will it be correct else it will not be.
Code:
' Wrong
ReDim ImageData(0 To 2, 0 To bm.bmWidth - 1, 0 To bm.bmHeight - 1)
' added this function I use to word align any bitmap bit depth
Public Function ByteAlignOnWord(ByVal bitDepth As Byte, ByVal Width As Long) As Long
' function to align any bit depth on dWord boundaries
ByteAlignOnWord = (((Width * bitDepth) + &H1F&) And Not &H1F&) \ &H8&
End Function
' now the ReDim may look like this
ReDim ImageData(0 To 2, 0 To ByteAlignOnWord(24,bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
3. In your GetImageData() routine you should verify that the following line of code does not return zero:
GetObject SrcPictureBox.Image, bmLen, bm
4. Tip: The line "
RGBColor = RGBValues(NewColor)" only needs to be executed one time. I would take it out of the loop.
hi LaVolte;)
now it's working.... thanks
but i still have not a nice results:(
my sub(with GetPixel() and SetPixel()), don't give me these result:(
why?
-
Re: [VB6] API DIBs - Change Image Colors
Can you post your updated SetImageData sub again?
-
Re: [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
LaVolpe
Can you post your updated SetImageData sub again?
Code:
'Routine to set an image's pixel information from an array dimensioned (rgb, x, y)
Public Sub SetImageData(ByRef DstPictureBox As PictureBox, ByRef ImageData() As Byte, ByRef OldColor As Long, ByRef NewColor As Long)
Dim X As Long, Y As Long
RGBColor = RGBValues(NewColor)
For X = 0 To bm.bmHeight - 1
For Y = 0 To bm.bmHeight - 1
If OldColor = RGB(ImageData(2, X, Y), ImageData(1, X, Y), ImageData(0, X, Y)) Then
ImageData(2, X, Y) = RGBColor.Red
ImageData(1, X, Y) = RGBColor.Green
ImageData(0, X, Y) = RGBColor.Blue
End If
Next Y
Next X
'Now that we've built the temporary header, we use StretchDIBits to take the data from the ImageData() array and put it into SrcPictureBox using the settings specified in 'bmi' (the StretchDIBits call should be on one continuous line)
StretchDIBits DstPictureBox.hDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0, 0), bmi, 0, vbSrcCopy
'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
'Note: always keep AutoRedraw as 'True' when using DIB sections. Otherwise, you WILL get unpredictable results.
If DstPictureBox.AutoRedraw = True Then
DstPictureBox.Picture = DstPictureBox.Image
DstPictureBox.Refresh
End If
End Sub
Code:
'Routine to get an image's pixel information into an array dimensioned (rgb, x, y)
Public Function GetImageData(ByRef SrcPictureBox As PictureBox, ByRef ImageData() As Byte) As Long
'Now we fill up the bmi (Bitmap information variable) with all of the appropriate data
bmi.bmHeader.bmSize = 40 'Size, in bytes, of the header (always 40)
bmi.bmHeader.bmPlanes = 1 'Number of planes (always one)
bmi.bmHeader.bmBitCount = 24 'Bits per pixel (always 24 for image processing)
bmi.bmHeader.bmCompression = 0 'Compression: none or RLE (always zero)
'Calculate the size of the bitmap type (in bytes)
bmLen = Len(bm)
'Get the picture box information from SrcPictureBox and put it into our 'bm' variable
GetObject SrcPictureBox.Image, bmLen, bm
If GetObject(SrcPictureBox.Image, bmLen, bm) = 0 Then
GetImageData = 0
Exit Function
Else
GetImageData = GetObject(SrcPictureBox.Image, bmLen, bm)
End If
'Build a correctly sized array.
ReDim ImageData(0 To 2, 0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
'Finish building the 'bmi' variable we want to pass to the GetDIBits call (the same variable we used above)
bmi.bmHeader.bmWidth = bm.bmWidth
bmi.bmHeader.bmHeight = bm.bmHeight
'Now that we've completely filled up the 'bmi' variable, we use GetDIBits to take the data from SrcPictureBox and put it into the ImageData() array using the settings we specified in 'bmi'
GetDIBits SrcPictureBox.hDC, SrcPictureBox.Image, 0, bm.bmHeight, ImageData(0, 0, 0), bmi, 0
End Function
-
Re: [VB6] API DIBs - Change Image Colors
my post #3. The 1st item I mentioned. You did not fix that.
Also you are calling this twice: GetObject SrcPictureBox.Image, bmLen, bm
-
Re: [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
LaVolpe
my post #3. The 1st item I mentioned. You did not fix that.
Also you are calling this twice: GetObject SrcPictureBox.Image, bmLen, bm
my mistake:(
i did it now, but still having the same problem:(
Code:
'Routine to set an image's pixel information from an array dimensioned (rgb, x, y)
Public Sub SetImageData(ByRef DstPictureBox As PictureBox, ByRef ImageData() As Byte, ByRef OldColor As Long, ByRef NewColor As Long)
Dim X As Long, Y As Long
RGBColor = RGBValues(NewColor)
For X = 0 To bm.bmWidth - 1
For Y = 0 To bm.bmHeight - 1
If OldColor = RGB(ImageData(2, X, Y), ImageData(1, X, Y), ImageData(0, X, Y)) Then
ImageData(2, X, Y) = RGBColor.Red
ImageData(1, X, Y) = RGBColor.Green
ImageData(0, X, Y) = RGBColor.Blue
End If
Next Y
Next X
'Now that we've built the temporary header, we use StretchDIBits to take the data from the ImageData() array and put it into SrcPictureBox using the settings specified in 'bmi' (the StretchDIBits call should be on one continuous line)
StretchDIBits DstPictureBox.hDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0, 0), bmi, 0, vbSrcCopy
'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
'Note: always keep AutoRedraw as 'True' when using DIB sections. Otherwise, you WILL get unpredictable results.
If DstPictureBox.AutoRedraw = True Then
DstPictureBox.Picture = DstPictureBox.Image
DstPictureBox.Refresh
End If
End Sub
-
Re: [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
LaVolpe
my post #3. The 1st item I mentioned. You did not fix that.
Also you are calling this twice: GetObject SrcPictureBox.Image, bmLen, bm
Code:
'Routine to get an image's pixel information into an array dimensioned (rgb, x, y)
Public Function GetImageData(ByRef SrcPictureBox As PictureBox, ByRef ImageData() As Byte) As Long
'Now we fill up the bmi (Bitmap information variable) with all of the appropriate data
bmi.bmHeader.bmSize = 40 'Size, in bytes, of the header (always 40)
bmi.bmHeader.bmPlanes = 1 'Number of planes (always one)
bmi.bmHeader.bmBitCount = 24 'Bits per pixel (always 24 for image processing)
bmi.bmHeader.bmCompression = 0 'Compression: none or RLE (always zero)
'Calculate the size of the bitmap type (in bytes)
bmLen = Len(bm)
'Get the picture box information from SrcPictureBox and put it into our 'bm' variable
GetImageData = GetObject(SrcPictureBox.Image, bmLen, bm)
If GetImageData = 0 Then Exit Function
'Build a correctly sized array.
ReDim ImageData(0 To 2, 0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
'Finish building the 'bmi' variable we want to pass to the GetDIBits call (the same variable we used above)
bmi.bmHeader.bmWidth = bm.bmWidth
bmi.bmHeader.bmHeight = bm.bmHeight
'Now that we've completely filled up the 'bmi' variable, we use GetDIBits to take the data from SrcPictureBox and put it into the ImageData() array using the settings we specified in 'bmi'
GetDIBits SrcPictureBox.hDC, SrcPictureBox.Image, 0, bm.bmHeight, ImageData(0, 0, 0), bmi, 0
End Function
now i fix that;)
but i still having the pixels problems:(
-
Re: [VB6] API DIBs - Change Image Colors
Sorry, I should have caught this....
Your loop is looping thru only a 3rd of the array. Here are some recommended changes
Code:
Dim X As Long, Y As Long
Dim lScanWidth As Long ' << added
lScanWidth = ByteAlignOnWord(24, bm.bmWidth) ' << added
RGBColor = RGBValues(NewColor)
For X = 0 To lScanWidth - 1 Step 3 ' << modified
....
-
Re: [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
LaVolpe
Sorry, I should have caught this....
Your loop is looping thru only a 3rd of the array. Here are some recommended changes
Code:
Dim X As Long, Y As Long
Dim lScanWidth As Long ' << added
lScanWidth = ByteAlignOnWord(24, bm.bmWidth) ' << added
RGBColor = RGBValues(NewColor)
For X = 0 To lScanWidth - 1 Step 3 ' << modified
....
now change less pixels:(
-
Re: [VB6] API DIBs - Change Image Colors
Yep, your 3D array is throwing my calculations off.
Here is how to do it with a 2D array. You can use this or modify your For:Next loop to work with 3D arrays. Your choice
2D array requires the following line changes
Code:
ReDim ImageData(0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
GetDIBits SrcPictureBox.hDC, SrcPictureBox.Image, 0, bm.bmHeight, ImageData(0, 0), bmi, 0
' replace loop like so:
For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 1 Step 3
For Y = 0 To bm.bmHeight - 1
If OldColor = RGB(ImageData(X, Y), ImageData(X, Y), ImageData(X, Y)) Then
ImageData(X + 2, Y) = RGBColor.Red
ImageData(X + 1, Y) = RGBColor.Green
ImageData(X, Y) = RGBColor.Blue
End If
Next Y
Next X
StretchDIBits DstPictureBox.hDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0), bmi, 0, vbSrcCopy
-
Re: [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
LaVolpe
Yep, your 3D array is throwing my calculations off.
Here is how to do it with a 2D array. You can use this or modify your For:Next loop to work with 3D arrays. Your choice
2D array requires the following line changes
Code:
ReDim ImageData(0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
GetDIBits SrcPictureBox.hDC, SrcPictureBox.Image, 0, bm.bmHeight, ImageData(0, 0), bmi, 0
' replace loop like so:
For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 1 Step 3
For Y = 0 To bm.bmHeight - 1
If OldColor = RGB(ImageData(X, Y), ImageData(X, Y), ImageData(X, Y)) Then
ImageData(X + 2, Y) = RGBColor.Red
ImageData(X + 1, Y) = RGBColor.Green
ImageData(X, Y) = RGBColor.Blue
End If
Next Y
Next X
StretchDIBits DstPictureBox.hDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0), bmi, 0, vbSrcCopy
i'm still having some problems in result:(
Code:
'Routine to get an image's pixel information into an array dimensioned (rgb, x, y)
Public Function GetImageData(ByRef SrcPictureBox As PictureBox, ByRef ImageData() As Byte) As Long
'Now we fill up the bmi (Bitmap information variable) with all of the appropriate data
bmi.bmHeader.bmSize = 40 'Size, in bytes, of the header (always 40)
bmi.bmHeader.bmPlanes = 1 'Number of planes (always one)
bmi.bmHeader.bmBitCount = 24 'Bits per pixel (always 24 for image processing)
bmi.bmHeader.bmCompression = 0 'Compression: none or RLE (always zero)
'Calculate the size of the bitmap type (in bytes)
bmLen = Len(bm)
'Get the picture box information from SrcPictureBox and put it into our 'bm' variable
GetImageData = GetObject(SrcPictureBox.Image, bmLen, bm)
If GetImageData = 0 Then Exit Function
'Build a correctly sized array.
ReDim ImageData(0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
'Finish building the 'bmi' variable we want to pass to the GetDIBits call (the same variable we used above)
bmi.bmHeader.bmWidth = bm.bmWidth
bmi.bmHeader.bmHeight = bm.bmHeight
'Now that we've completely filled up the 'bmi' variable, we use GetDIBits to take the data from SrcPictureBox and put it into the ImageData() array using the settings we specified in 'bmi'
GetDIBits SrcPictureBox.hDC, SrcPictureBox.Image, 0, bm.bmHeight, ImageData(0, 0), bmi, 0
End Function
'Routine to set an image's pixel information from an array dimensioned (rgb, x, y)
Public Sub SetImageData(ByRef DstPictureBox As PictureBox, ByRef ImageData() As Byte, ByRef OldColor As Long, ByRef NewColor As Long)
Dim X As Long, Y As Long
RGBColor = RGBValues(NewColor)
For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 1 Step 3
For Y = 0 To bm.bmHeight - 1
If OldColor = RGB(ImageData(X, Y), ImageData(X, Y), ImageData(X, Y)) Then
ImageData(X + 2, Y) = RGBColor.Red
ImageData(X + 1, Y) = RGBColor.Green
ImageData(X, Y) = RGBColor.Blue
End If
Next Y
Next X
'Now that we've built the temporary header, we use StretchDIBits to take the data from the ImageData() array and put it into SrcPictureBox using the settings specified in 'bmi' (the StretchDIBits call should be on one continuous line)
StretchDIBits DstPictureBox.hDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0), bmi, 0, vbSrcCopy
'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
'Note: always keep AutoRedraw as 'True' when using DIB sections. Otherwise, you WILL get unpredictable results.
If DstPictureBox.AutoRedraw = True Then
DstPictureBox.Picture = DstPictureBox.Image
DstPictureBox.Refresh
End If
End Sub
-
1 Attachment(s)
Re: [VB6] API DIBs - Change Image Colors
see the image result.
has you can see, not only the eyes was changed. but some part of the head too:(
why?
is about the variables types?
oldcolor and newcolor are long, and ImageData() is byte.
heres how i use it:
Code:
Private Sub Command1_Click()
Dim imgData() As Byte
GetImageData Picture1, imgData()
SetImageData Picture2, imgData(), Picture3.BackColor, Picture4.BackColor
End Sub
-
Re: [VB6] API DIBs - Change Image Colors
i can do it(with a correct result) with these sub:
Code:
Public Sub ChangeColor(Picture As Object, OldColor As Long, NewColor As Long)
Dim mDC As Long
Dim mBMP As Long
Dim PosX As Long
Dim PosY As Long
Dim PixelColor As Long
Dim ScaleMode As Integer
Dim AutoRedraw As Boolean
ScaleMode = Picture.ScaleMode
Picture.ScaleMode = 3
AutoRedraw = Picture.AutoRedraw
Picture.AutoRedraw = True
mDC = CreateCompatibleDC(Picture.hdc)
mBMP = CreateCompatibleBitmap(Picture.hdc, Picture.ScaleWidth, Picture.ScaleHeight)
SelectObject mDC, mBMP
BitBlt mDC, 0, 0, Picture.ScaleWidth, Picture.ScaleHeight, Picture.hdc, 0, 0, vbSrcCopy
For PosX = 0 To Picture.ScaleWidth
For PosY = 0 To Picture.ScaleHeight
PixelColor = GetPixel(mDC, PosX, PosY)
If PixelColor <> -1 Then
If PixelColor = OldColor Then
SetPixel mDC, PosX, PosY, NewColor
End If
End If
Next PosY
Next PosX
BitBlt Picture.hdc, 0, 0, Picture.ScaleWidth, Picture.ScaleHeight, mDC, 0, 0, vbSrcCopy
Picture.ScaleMode = ScaleMode
Picture.Picture = Picture.Image
Picture.AutoRedraw = AutoRedraw
DeleteObject mBMP
DeleteDC mDC
End Sub
but i need speed. and the only way is the DIB code:(
i can control these entire code;)
do what i need with pixels;)
but like i said, i want speed;)
i show you these for you catch more what i mean;)
thank you for help me my friend... thanks
-
Re: [VB6] API DIBs - Change Image Colors
1. For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 3 Step 3
2. If OldColor = RGB(ImageData(X + 2, Y), ImageData(X + 1, Y), ImageData(X, Y)) Then
-
Re: [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
LaVolpe
1. For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 3 Step 3
2. If OldColor = RGB(ImageData(X + 2, Y), ImageData(X + 1, Y), ImageData(X, Y)) Then
sorry in 2nd point:(
i didn't get it:(
now it's working fine;)
thanks
now i can working with DIB's easy;)
Code:
'Routine to set an image's pixel information from an array dimensioned (rgb, x, y)
Public Sub SetImageData(ByRef DstPictureBox As PictureBox, ByRef ImageData() As Byte, ByRef OldColor As Long, ByRef NewColor As Long)
Dim X As Long, Y As Long
RGBColor = RGBValues(NewColor)
For X = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 3 Step 3
For Y = 0 To bm.bmHeight - 1
If OldColor = RGB(ImageData(X + 2, Y), ImageData(X + 1, Y), ImageData(X, Y)) Then
ImageData(X + 2, Y) = RGBColor.Red
ImageData(X + 1, Y) = RGBColor.Green
ImageData(X, Y) = RGBColor.Blue
End If
Next Y
Next X
'Now that we've built the temporary header, we use StretchDIBits to take the data from the ImageData() array and put it into SrcPictureBox using the settings specified in 'bmi' (the StretchDIBits call should be on one continuous line)
StretchDIBits DstPictureBox.hDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0), bmi, 0, vbSrcCopy
'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
'Note: always keep AutoRedraw as 'True' when using DIB sections. Otherwise, you WILL get unpredictable results.
If DstPictureBox.AutoRedraw = True Then
DstPictureBox.Picture = DstPictureBox.Image
DstPictureBox.Refresh
End If
End Sub
-
Re: [VB6] API DIBs - Change Image Colors
now i'm trying put it in my Sprite 2D control;)
but i catch 1 error. before works 100% well, now i catch 1 error:(
sometimes i don't understand:(
in a module:
Code:
'Some functions for work with bitmaps\Images
Option Explicit
Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Public 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
Public Declare Function AlphaBlend Lib "msimg32" (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 widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbAlpha As Byte
End Type
Private Type BITMAPINFO
bmHeader As BITMAPINFOHEADER
bmColors(0 To 255) As RGBQUAD
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 GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _
ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _
ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Private Type Color
Red As Long
Green As Long
Blue As Long
End Type
Dim hbmp As Long
Dim bih As BITMAPINFOHEADER
Dim bmpBits() As Long
Private Const DIB_RGB_COLORS As Long = 0
Public Const SRCCOPY = &HCC0020
'Routine to set an image's pixel information from an array dimensioned (rgb, x, y)
Public Sub DIBChangeImageColor(ByRef SrcPicturebox As PictureBox, ByRef DstPictureBox As PictureBox, ByRef OldColor As Long, ByRef NewColor As Long)
Dim X As Long, Y As Long
Dim ImageData() As Byte
Dim bmLen As Long
Dim bm As BITMAP
Dim bmi As BITMAPINFO
Dim RGBColor As Color
'Now we fill up the bmi (Bitmap information variable) with all of the appropriate data
bmi.bmHeader.biSize = 40 'Size, in bytes, of the header (always 40)
bmi.bmHeader.biPlanes = 1 'Number of planes (always one)
bmi.bmHeader.biBitCount = 24 'Bits per pixel (always 24 for image processing)
bmi.bmHeader.biCompression = 0 'Compression: none or RLE (always zero)
'Calculate the size of the bitmap type (in bytes)
bmLen = Len(bm)
GetObject SrcPicturebox.Image, bmLen, bm
'Build a correctly sized array.
ReDim ImageData(0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
'Finish building the 'bmi' variable we want to pass to the GetDIBits call (the same variable we used above)
bmi.bmHeader.biWidth = bm.bmWidth 'now it's bi and not bm
bmi.bmHeader.biHeight = bm.bmHeight 'now it's bi and not bm
'Now that we've completely filled up the 'bmi' variable, we use GetDIBits to take the data from SrcPictureBox and put it into the ImageData() array using the settings we specified in 'bmi'
GetDIBits SrcPicturebox.hdc, SrcPicturebox.Image, 0, bm.bmHeight, ImageData(0, 0), bmi, 0 'bmi is give me the error:( "byref argument type mismatch"
RGBColor = RGBValues(NewColor)
For X = 0 To ByteAlignOnWord(bmi.bmHeader.biBitCount, bm.biWidth) - 3 Step 3
For Y = 0 To bm.bmHeight - 1
If OldColor = RGB(ImageData(X + 2, Y), ImageData(X + 1, Y), ImageData(X, Y)) Then
ImageData(X + 2, Y) = RGBColor.Red
ImageData(X + 1, Y) = RGBColor.Green
ImageData(X, Y) = RGBColor.Blue
End If
Next Y
Next X
'Now that we've built the temporary header, we use StretchDIBits to take the data from the ImageData() array and put it into SrcPictureBox using the settings specified in 'bmi' (the StretchDIBits call should be on one continuous line)
StretchDIBits DstPictureBox.hdc, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0), bmi, 0, vbSrcCopy
'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
'Note: always keep AutoRedraw as 'True' when using DIB sections. Otherwise, you WILL get unpredictable results.
If DstPictureBox.AutoRedraw = True Then
DstPictureBox.Picture = DstPictureBox.Image
DstPictureBox.Refresh
End If
End Sub
please help me correct these last error:(
in these line:
Code:
GetDIBits SrcPicturebox.hdc, SrcPicturebox.Image, 0, bm.bmHeight, ImageData(0, 0), bmi, 0 'bmi is give me the error:( "byref argument type mismatch"
error message: "compiler error: byref argument type mismatch".
thanks
-
Re: [VB6] API DIBs - Change Image Colors
hmmm
1. You added: Dim bmi As BITMAPINFO
2. The API has: ... lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long ...
-
1 Attachment(s)
Re: [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
LaVolpe
hmmm
1. You added: Dim bmi As BITMAPINFO
2. The API has: ... lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long ...
sorry. now i'm building 100% new Graphic module(with your help... thanks) for put in my Sprite control.
now i need to catch the real image size:
Code:
Private Declare Function GetBitmapDimensionEx Lib "gdi32" (ByVal hBitmap As Long, lpDimension As Size) As Long
Private Type Size
cx As Long
cy As Long
End Type
Dim bitmapsize As Size
Public Sub ImageSize(ByRef Picture As Control)
GetBitmapDimensionEx Picture.Picture.Handle, bitmapsize
Debug.Print bitmapsize.cx
End Sub
my problem here is that i only recive 0(zero):(
why?
-
Re: [VB6] API DIBs - Change Image Colors
Per MSDN's documentation on that function...
Quote:
The GetBitmapDimensionEx function retrieves the dimensions of a compatible bitmap. The retrieved dimensions must have been set by the SetBitmapDimensionEx function
If you are wanting the size of a picture object, use ScaleX/ScaleY
Code:
Width = ScaleX(Control.Picture.Width, vbHimetric, vbPixels)
Height = ScaleY(Control.Picture.Height, vbHimetric, vbPixels)
You could also use APIs if you were interested in image sizes based on just a bitmap handle.
-
Re: [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
LaVolpe
Per
MSDN's documentation on that function...
If you are wanting the size of a picture object, use ScaleX/ScaleY
Code:
Width = ScaleX(Control.Picture.Width, vbHimetric, vbPixels)
Height = ScaleY(Control.Picture.Height, vbHimetric, vbPixels)
You could also use APIs if you were interested in image sizes based on just a bitmap handle.
works fine;)
thanks
-
Re: [RESOLVED] [VB6] API DIBs - Change Image Colors
How to save the image???
Thx
-
Re: [RESOLVED] [VB6] API DIBs - Change Image Colors
Quote:
Originally Posted by
bewolf
How to save the image???
Thx
Code:
SavePicture objectname.picture, "filename"
;)
