-
December 8th, 2020, 03:15 PM
#1
how use DIB's?
i have these 2 functions for get pixels:
Code:
Public Sub GetImageData(ByRef SourcehBitmap As Long, ByRef SourceHDC As Long, ByRef ImageData() As Byte)
'Declare variables of the necessary bitmap types
Dim bm As BITMAP
Dim bmi As BITMAPINFO
'Now we fill up the bmi (Bitmap information variable) with all the necessary 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)
Dim bmLen As Long
bmLen = Len(bm)
'Get the picture box information from SrcPictureBox and put it into our 'bm' variable
GetObject SourcehBitmap, bmLen, bm
bm.bmBitsPixel = 32
'Build a correctly sized array.
ReDim ImageData(0 To (bm.bmBitsPixel \ 8) - 1, 0 To bm.bmWidth - 1, 0 To bm.bmHeight - 1)
'Finish building the 'bmi' variable we want to pass to the GetDIBits call
bmi.bmHeader.bmWidth = bm.bmWidth
bmi.bmHeader.bmHeight = bm.bmHeight
'Now that we've filled the 'bmi' variable, we use GetDIBits to take the data from SrcPictureBox and put
' it into the ImageData() array using the settings specified in 'bmi'
GetDIBits SourceHDC, SourcehBitmap, 0, bm.bmHeight, ImageData(0, 0, 0), bmi, 0
End Sub
Public Sub SetImageData(ByRef HBitmap As Long, ByRef DestinationHDC As Long, ByRef ImageData() As Byte)
'Variables for the necessary bitmap types
Dim bm As BITMAP
Dim bmi As BITMAPINFO
'Fill the bmi (Bitmap information variable) with appropriate values
bmi.bmHeader.bmSize = 40
bmi.bmHeader.bmPlanes = 1
bmi.bmHeader.bmBitCount = 24
bmi.bmHeader.bmCompression = 0
'Calculate the size of the bitmap type (in bytes)
Dim bmLen As Long
bmLen = Len(bm)
'Get the picture box information from DstPictureBox and put it into our 'bm' variable
GetObject HBitmap, bmLen, bm
'Now that we know the object's size, finish building the temporary header to pass to StretchDIBits
bmi.bmHeader.bmWidth = bm.bmWidth
bmi.bmHeader.bmHeight = bm.bmHeight
bm.bmBitsPixel = 32
'Use StretchDIBits to take the data from the ImageData() array and put it into SrcPictureBox using
' the settings specified in 'bmi'
StretchDIBits DestinationHDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, _
ImageData(0, 0, 0), bmi, 0, vbSrcCopy
End Sub
i get the array... but when i try change something:
Code:
Public Sub DrawAlphaBlend(ByRef DestinationDC As Long, AlphaValue As Long) Dim BF As Long
Const USE_BITMAP_ALPHA = &H1000000 'AC_SRC_ALPHA scaled up to the 4th byte of a long
'BF = 128 * &H10000 'semi transparent ignoring bitmaps alpha channel
BF = AlphaValue * &H10000 Or USE_BITMAP_ALPHA 'fully opaque using bitmaps alpha channel
'AlphaBlend DestinationDC, 0, 0, Width, Height, hdc, 0, 0, Width, Height, BF
GetImageData HBitmap, hdc, Pixels()
Dim x As Long, y As Long
For x = 0 To Width - 1
For y = 0 To Height - 1
If Pixels(2, x, y) = 255 And Pixels(1, x, y) = 0 And Pixels(0, x, y) = 0 Then
Pixels(2, x, y) = 0
Pixels(1, x, y) = 255
Pixels(0, x, y) = 0
End If
Next y
Next x
SetImageData HBitmap, DestinationDC, Pixels
End Sub
i get these result(tested with gif file):
how can i fix these bug?
in these case i'm changing the red to green.. even if i change the alpha, i will get the same result
i use GDIPLUS for get the image:
Code:
Public Sub FromFile(FileName As String) If FileName = "" Then Exit Sub
DeleteObjects
hdc = CreateCompatibleDC(GetDC(GetForegroundWindow()))
GdipCreateFromHDC hdc, Graphics
If Graphics Then
Call GdipLoadImageFromFile(StrPtr(FileName), BITMAP)
If BITMAP Then
GdipGetImageHeight BITMAP, Height
GdipGetImageWidth BITMAP, Width
GdipCreateHBITMAPFromBitmap BITMAP, HBitmap, &O0
SelectObject hdc, HBitmap
End If
End If
End Sub
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|