Hello!

I am stuck while trying to cut out the object of a dropshadow.

What I am trying to achieve is this (photoshopped version):

Name: shadowonly1.png Views: 308 Size: 13.8 KB

But actually, it looks like this:

Name: actual.png Views: 307 Size: 11.3 KB

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
Name: steps1.jpg Views: 286 Size: 27.7 KB

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