I am stuck while trying to cut out the object of a dropshadow.
What I am trying to achieve is this (photoshopped version):
But actually, it looks like this:
I don't find the flaw in my code.
Perhaps the flaw lays in the masking part, but I am not sure.
Thank you if anybody can lend a hand.
This is the main function:
Code:
Public Function CreateDropShadow(ByRef uSourceSurface As cCairoSurface, ByVal uRadius As Long, ByVal uColor As Long, ByVal uAlpha As Double) As cCairoSurface
' Convert the specified alpha to a byte value
Dim btAlpha As Byte
btAlpha = pConvertAlpha(uAlpha)
' Create a copy of the source surface where non-transparent pixels are made black and opaque
Dim nGrey As cCairoSurface
Set nGrey = uSourceSurface.CreateSimilar(CAIRO_CONTENT_COLOR_ALPHA, uSourceSurface.Width, uSourceSurface.Height, True)
modCairo.SetBlackIfPixelIsOpaque nGrey
' Create a mask surface where non-transparent pixels from the original are black and the rest are transparent
Dim nObjectIsOpaque_RestIsTransparent As cCairoSurface
Set nObjectIsOpaque_RestIsTransparent = uSourceSurface.CreateSimilar(CAIRO_CONTENT_COLOR_ALPHA, uSourceSurface.Width, uSourceSurface.Height, True)
modCairo.SetBlackIfPixelIsOpaque nObjectIsOpaque_RestIsTransparent
nObjectIsOpaque_RestIsTransparent.WriteContentToPngFile "d:\temp\OpaquePixelsAreNowBlack.png"
modCairo.SetWhiteIfPixelIsTransparent nObjectIsOpaque_RestIsTransparent
nObjectIsOpaque_RestIsTransparent.WriteContentToPngFile "d:\temp\TransparentPixelsAreNowWhite.png"
nObjectIsOpaque_RestIsTransparent.WriteContentToPngFile "d:\temp\ObjectBlackRestWhite.png"
modCairo.MakeBlackPixelsTransparent nObjectIsOpaque_RestIsTransparent
nObjectIsOpaque_RestIsTransparent.WriteContentToPngFile "d:\temp\ObjectIsNowOpaque.png"
' Apply Gaussian Blur to the nGrey surface
Dim nGreyWithBlur As cCairoSurface
Set nGreyWithBlur = nGrey.CreateSimilar(CAIRO_CONTENT_COLOR_ALPHA, nGrey.Width, nGrey.Height, True)
Dim nGreyWithBlurC As cCairoContext
Set nGreyWithBlurC = nGreyWithBlur.CreateContext
Set nGreyWithBlur = nGreyWithBlur.GaussianBlur(uRadius / 2, uRadius, False)
nGreyWithBlur.WriteContentToPngFile "D:\temp\shadow.png"
' Create a mask for subtracting the object from the shadow
Dim nMask As cCairoSurface
Set nMask = nGrey.CreateSimilar(CAIRO_CONTENT_COLOR_ALPHA, nGrey.Width, nGrey.Height, True)
Dim nMaskC As cCairoContext
Set nMaskC = nMask.CreateContext
nMaskC.SetSourceRGBA 0, 0, 0, 1
nMaskC.Paint
nMaskC.SetSourceSurface nObjectIsOpaque_RestIsTransparent, 0, 0
nMaskC.Operator = CAIRO_OPERATOR_DEST_OUT
nMaskC.Paint
' Create the final shadow surface, excluding the object
Dim nShadowOnly As cCairoSurface
Set nShadowOnly = nGreyWithBlur.CreateSimilar(CAIRO_CONTENT_COLOR_ALPHA, nGreyWithBlur.Width, nGreyWithBlur.Height, True)
Dim nShadowOnlyC As cCairoContext
Set nShadowOnlyC = nShadowOnly.CreateContext
nShadowOnlyC.SetSourceSurface nGreyWithBlur, 0, 0
nShadowOnlyC.MaskSurface nMask, 0, 0
nShadowOnlyC.Paint
' Save the shadow image to a file
Dim sFilepathShadowOnly As String
sFilepathShadowOnly = "d:\temp\shadowonly.png"
modIO.DeleteFile sFilepathShadowOnly
nShadowOnly.WriteContentToPngFile sFilepathShadowOnly
Set CreateDropShadow = nShadowOnly
End Function
These are the helper functions that I use:
Code:
Public Sub MakeSemitransparentFullyOpaque(Srf As cCairoSurface)
Dim X As Long, Y As Long, b() As Byte
Srf.BindToArray b
Dim lLimit&
lLimit = 5
For Y = 0 To UBound(b, 2): For X = 0 To UBound(b, 1) Step 4
If b(X + 3, Y) > 0 Then 'And b(X + 3, y) > 0 Then 'when semi-transparent (in a certain range)...
' b(X + 0, y) = 0
' b(X + 1, y) = 0
' b(X + 2, y) = 0
b(X + 3, Y) = 255 ' 255 'ShadowAlpha '255 = completely black/opaque 0=completely transparent, 124=halftransparent
End If
Next X, Y
Srf.ReleaseArray b
End Sub
Public Sub MakeWhitePixelsOpaque(ByRef Srf As cCairoSurface)
Dim X As Long, Y As Long, b() As Byte
' Bind the surface to a byte array for direct pixel manipulation
Srf.BindToArray b
' Loop through each pixel in the byte array
For Y = 0 To UBound(b, 2) ' Iterate over each row
For X = 0 To UBound(b, 1) Step 4 ' Iterate over each pixel, skipping every 4 bytes (RGBA)
' Check if the pixel is black, meaning all RGB values are at minimum (0)
If b(X + 0, Y) = 255 And b(X + 1, Y) = 255 And b(X + 2, Y) = 255 Then
' Set alpha component to 255 to make the pixel fully opaque
b(X + 3, Y) = 255
End If
Next X
Next Y
' Release the array back to the surface, applying the changes
Srf.ReleaseArray b
End Sub
Public Sub MakeBlackPixelsOpaque(ByRef Srf As cCairoSurface)
Dim X As Long, Y As Long, b() As Byte
' Bind the surface to a byte array for direct pixel manipulation
Srf.BindToArray b
' Loop through each pixel in the byte array
For Y = 0 To UBound(b, 2) ' Iterate over each row
For X = 0 To UBound(b, 1) Step 4 ' Iterate over each pixel, skipping every 4 bytes (RGBA)
' Check if the pixel is black, meaning all RGB values are at minimum (0)
If b(X + 0, Y) = 0 And b(X + 1, Y) = 0 And b(X + 2, Y) = 0 Then
' Set alpha component to 255 to make the pixel fully opaque
b(X + 3, Y) = 255
End If
Next X
Next Y
' Release the array back to the surface, applying the changes
Srf.ReleaseArray b
End Sub
Public Sub MakeBlackPixelsTransparent(ByRef Srf As cCairoSurface)
Dim X As Long, Y As Long, b() As Byte
' Bind the surface to a byte array for direct pixel manipulation
Srf.BindToArray b
' Loop through each pixel in the byte array
For Y = 0 To UBound(b, 2) ' Iterate over each row
For X = 0 To UBound(b, 1) Step 4 ' Iterate over each pixel, skipping every 4 bytes (RGBA)
' Check if the pixel is white, meaning all RGB values are at maximum (255)
If b(X + 0, Y) = 0 And b(X + 1, Y) = 0 And b(X + 2, Y) = 0 Then
' Set alpha component to 0 to make the pixel fully transparent
b(X + 3, Y) = 0
End If
Next X
Next Y
' Release the array back to the surface, applying the changes
Srf.ReleaseArray b
End Sub
Public Sub MakeWhitePixelsTransparent(ByRef Srf As cCairoSurface)
Dim X As Long, Y As Long, b() As Byte
' Bind the surface to a byte array for direct pixel manipulation
Srf.BindToArray b
' Loop through each pixel in the byte array
For Y = 0 To UBound(b, 2) ' Iterate over each row
For X = 0 To UBound(b, 1) Step 4 ' Iterate over each pixel, skipping every 4 bytes (RGBA)
' Check if the pixel is white, meaning all RGB values are at maximum (255)
If b(X + 0, Y) = 255 And b(X + 1, Y) = 255 And b(X + 2, Y) = 255 Then
' Set alpha component to 0 to make the pixel fully transparent
b(X + 3, Y) = 0
End If
Next X
Next Y
' Release the array back to the surface, applying the changes
Srf.ReleaseArray b
End Sub
Public Sub SetWhiteIfPixelIsTransparent(ByRef Srf As cCairoSurface)
Dim X As Long, Y As Long, b() As Byte
Srf.BindToArray b
Dim lLimit&
lLimit = 5
For Y = 0 To UBound(b, 2): For X = 0 To UBound(b, 1) Step 4
If b(X + 3, Y) < lLimit Then
b(X + 0, Y) = 255
b(X + 1, Y) = 255
b(X + 2, Y) = 255
'... and makeit fully opaque
b(X + 3, Y) = 255 '= completely black/opaque 0=completely transparent, 124=halftransparent
End If
Next X, Y
Srf.ReleaseArray b
End Sub
Public Sub SetWhiteIfPixelIsOpaque(ByRef Srf As cCairoSurface)
Dim X As Long, Y As Long, b() As Byte
Srf.BindToArray b
Dim lLimit&
lLimit = 5
For Y = 0 To UBound(b, 2): For X = 0 To UBound(b, 1) Step 4
If b(X + 3, Y) > lLimit Then 'And b(X + 3, y) > lLimit Then 'when semi-transparent (in a certain range)...
b(X + 0, Y) = 255
b(X + 1, Y) = 255
b(X + 2, Y) = 255
'... and makeit fully opaque
b(X + 3, Y) = 255 '= completely black/opaque 0=completely transparent, 124=halftransparent
End If
Next X, Y
Srf.ReleaseArray b
End Sub
Public Sub SetBlackIfPixelIsOpaque(ByRef Srf As cCairoSurface)
Dim X As Long, Y As Long, b() As Byte
Srf.BindToArray b
Dim lLimit&
lLimit = 5
For Y = 0 To UBound(b, 2): For X = 0 To UBound(b, 1) Step 4
If b(X + 3, Y) > lLimit Then
'make pixel black
b(X + 0, Y) = 0
b(X + 1, Y) = 0
b(X + 2, Y) = 0
'... and fully opaque
b(X + 3, Y) = 255 ' '255 = completely black/opaque 0=completely transparent, 124=halftransparent
End If
Next X, Y
Srf.ReleaseArray b
End Sub
Public Sub SetBlackIfPixelIsTransparent(ByRef Srf As cCairoSurface)
Dim X As Long, Y As Long, b() As Byte
Srf.BindToArray b
Dim lLimit&
lLimit = 5
For Y = 0 To UBound(b, 2): For X = 0 To UBound(b, 1) Step 4
If b(X + 3, Y) < lLimit Then 'And b(X + 3, y) < lLimit Then 'when semi-transparent (in a certain range)...
'make pixel black
b(X + 0, Y) = 0
b(X + 1, Y) = 0
b(X + 2, Y) = 0
'... and fully opaque
b(X + 3, Y) = 255 ' '255 = completely black/opaque 0=completely transparent, 124=halftransparent
End If
Next X, Y
Srf.ReleaseArray b
End Sub
Private Function pConvertAlpha(alpha As Double) As Integer
If alpha < 0 Then alpha = 0
If alpha > 1 Then alpha = 1
pConvertAlpha = Int(alpha * 255 + 0.5)
End Function
I don't really understand what you mean, I don't know if the following code will help you:
Form1
Code:
Option Explicit
Private BtnColor As Long
Private Sub Form_Load()
Draw
End Sub
Private Sub Draw()
Me.Cls
AutoRedraw = True
BackColor = vbWhite '--- &HF0F0F0
Dim CC As cCairoContext
Set CC = Cairo.CreateSurface(Me.ScaleWidth, Me.ScaleHeight).CreateContext
CC.Paint 1, Cairo.CreateSolidPatternLng(vbWhite)
'CC.Paint 1, Cairo.CreateCheckerPattern
Dim Srf As cCairoSurface, ShadowSrf As cCairoSurface, nShadowSize As Long, nRadius As Long
Dim nShadowOffsetX As Long, nShadowOffsetY As Long
BtnColor = vbRed '&H995833
nShadowSize = 5
nShadowOffsetX = 0
nShadowOffsetY = 0
nRadius = 5
Set Srf = CreateTestSrf(111, 45, BtnColor, , nRadius)
'--- Method1 ---
'Set ShadowSrf = CreateDropShadow(Srf, nRadius, vbBlue, 0.1)
'
'--- Method2 ---
Set ShadowSrf = Srf.GaussianBlur(nShadowSize / 2, nRadius, True, &HE0E0E0)
CC.RenderSurfaceContent ShadowSrf, nShadowOffsetX, nShadowOffsetY
CC.RenderSurfaceContent Srf, 0, 0
CC.Surface.DrawToDC Me.hDC
End Sub
Private Function CreateTestSrf(dx, dy, nColor, Optional ByVal nBackColor& = -1, Optional ByVal nRadius As Long = 0) As cCairoSurface
Set CreateTestSrf = Cairo.CreateSurface(dx, dy)
Dim CC As cCairoContext, Pat As cCairoPattern
Set CC = CreateTestSrf.CreateContext
CC.SetLineWidth 1
If nBackColor <> -1 Then CC.Paint 1, Cairo.CreateSolidPatternLng(nBackColor)
CC.RoundedRect 0, 0, dx, dy, nRadius
CC.SetSourceColor nColor
CC.Fill
End Function
I want to "cut away" the object that was used to create the gaussian blur.
Only the gaussian blur should remain.
The rest of the image should be transparent.
I had to make a few experiments to find out what is wrong.
What exactely what was wrong I still can not say, but while fighting my way through it, I learnt a bit more about operators.
Here is a sample project for testing in case somebody should need that.
Last edited by tmighty2; Nov 22nd, 2024 at 12:26 AM.
Hi,
I was experimenting with Mask.
I didn't quite understand it, but it seems to work better the following way (in case it's useful). (DEST_IN, DEST_OUT)
Code:
' nFinalCheeseC.Operator = iOperator
' nFinalCheeseC.MaskSurface nMask, 0, 0 ' Apply mask
' nFinalCheeseC.RenderSurfaceContent nShouldHaveHoles, 0, 0 ' Draw the main image where the mask allows
nFinalCheeseC.Operator = iOperator
nFinalCheeseC.SetSourceSurface nShouldHaveHoles
nFinalCheeseC.MaskSurface nMask, 0, 0 ' Apply mask
cCairoSurface: Masking
Reply With Quote
