cCairoSurface: Masking

Hello!

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

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

Attachment 193519

But actually, it looks like this:

Attachment 193520

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

---

Attachment 193521

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

---

Also, if you want the top and left sides of the Shadow-Surface to have no blank spaces, you can use the following method:

Code:

---

nShadowOffsetX = -10
nShadowOffsetY = -10
CC.RenderSurfaceContent ShadowSrf, nShadowOffsetX, nShadowOffsetY

---

Thank you, but this is not what I want.

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.

Since Srf and ShadowSrf are two different surfaces, isn't hiding Srf equivalent to cutting Srf?

No, that is not the same.

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.

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

---