RichClient: CairoSurface

I have created a cCairoSurface from bytes like this:

Code:

---

Dim s As cCairoSurface
Set s = modCairo.CairoSurfaceFromBytes(m_PngBytesBGRemoved)

---

Next, I crop it so that all outer transparent pixels are gone:

Code:

---

Set s = modCairo.CropToCairoSurface(s)

Public Function CropToCairoSurface(Src As cCairoSurface) As cCairoSurface
    Dim x As Long, y As Long, dx As Long, dy As Long
    FindInnerRectangle Src, x, y, dx, dy

    Dim croppedSurface As cCairoSurface
    Set croppedSurface = Src.CropSurface(x, y, dx, dy)
   
    Set CropToCairoSurface = croppedSurface
End Function

---

Then I want to render the resulting surface to a picturebox. I want to visualize which parts of the image are transparent and which are opaque. I have chosen to use a checkerboard for that.

I want to draw this checkerboard onto the picturebox, then the surface s over it. However, since cCairoSurface uses StretchDiBits under the hood, which knows nothing about transparency, this does not work. The contents of "s" would completely draw over the checkerboard. Transparent regions would render as black.

I have not yet found a way to achieve this. Here's the code where I try to render s:


And here's the pRenderOther procedure. It's riddled with various attempts of mine which all didn't work, so I wasn't really sure what I should post, so I just post my current attempt:

Code:

---

Private Sub pRenderOther(ByRef u As cCairoSurface)
On Error GoTo errhandler
    Me.picOther.AutoRedraw = True
    Me.picOther.Cls

    Dim rImage As RECT
    GetWindowRect Me.picOther.hwnd, rImage

    Dim lWidth&
    Dim lHeight&
    lWidth = rImage.Right - rImage.Left
    lHeight = rImage.Bottom - rImage.Top

    Dim nCheck As cCairoSurface
    Set nCheck = Cairo.CreateCheckerSrf

    Dim lNewWidth&
    Dim lNewHeight&
   
    ' This was one of my attempts, but as I explained, I just don't seem to be able to render the cCairoSurface in a way that respects the transparency
    Dim c As c32bppDIB
    Set c = New c32bppDIB
    c.LoadDIBinDC True
    c.InitializeDIB Me.picOther.Width, Me.picOther.Height
    c.CreateCheckerBoard
    c.Render Me.picOther.hdc

    Dim d As c32bppDIB
    Set d = CreateDIB32FromSurface(u)
    d.Render Me.picOther.hdc

    Dim nBytes() As Byte
    If u.WriteContentToPngByteArray(nBytes) Then

    Else
        ' Does not work for some reason. Not sure yet why.
        Debug.Assert False
        Exit Sub
    End If

    c.LoadPicture_Stream nBytes

    ScaleImage c.Width, c.Height, Me.picOther.Width, Me.picOther.Height, lNewWidth, lNewHeight, scaleDownAsNeeded
   
    Dim lLeft&
    Dim lTop&
    lLeft = (lWidth - lNewWidth) / 2
    lTop = (lHeight - lNewHeight) / 2
    c.Render Me.picRemBGDone.hdc, lLeft, lTop, lNewWidth, lNewHeight

Exit Sub
errhandler:
Debug.Assert False
End Sub

---

Here are the helper functions:

Code:

---

Public Function CairoSurfaceFromBytes(pngBytes() As Byte) As cCairoSurface
    Dim srf As cCairoSurface
    Set srf = Cairo.CreateSurface(0, 0, ImageSurface, pngBytes)
    Set CairoSurfaceFromBytes = srf
End Function


Public Sub FindInnerRectangle(Src As cCairoSurface, ByRef x As Long, ByRef y As Long, ByRef dx As Long, ByRef dy As Long)
    Dim srcX&, srcY&
    Dim srcP&(): Src.BindToArrayLong srcP

    Dim minX&, maxX&, minY&, maxY&
    minX = UBound(srcP, 1)
    maxX = 0
    minY = UBound(srcP, 2)
    maxY = 0

    For srcY = 0 To UBound(srcP, 2)
        For srcX = 0 To UBound(srcP, 1)
            ' Prüfen, ob die Farbe NICHT weiß ist
            If Not IsColorTransparent(srcP(srcX, srcY)) Then
                If srcX < minX Then minX = srcX
                If srcX > maxX Then maxX = srcX
                If srcY < minY Then minY = srcY
                If srcY > maxY Then maxY = srcY
            End If
        Next srcX
    Next srcY

    Src.ReleaseArrayLong srcP

    ' Setzen der Koordinaten und Größen
    x = minX
    y = minY
    dx = maxX - minX + 1
    dy = maxY - minY + 1
End Sub
Public Function ColorToRGBA(ByVal uColor As Long, ByRef r As Byte, ByRef g As Byte, ByRef b As Byte, ByRef a As Byte)

    r = uColor And &HFF
    g = (uColor \ &H100) And &HFF
    b = (uColor \ &H10000) And &HFF

    a = (uColor \ &H1000000) And &HFF

End Function

Private Function IsColorTransparent(color As Long) As Boolean

    Dim Tolerance&
    Tolerance = 5

    Dim red As Byte
    Dim green As Byte
    Dim blue As Byte
    Dim alpha As Byte

    ColorToRGBA color, red, green, blue, alpha

    If alpha < Tolerance Then
        IsColorTransparent = True
    Else
        IsColorTransparent = (red > 240) And (green > 240) And (blue > 240)
    End If

End Function

---

Edit:

I am puzzled how this function works:

CreateCheckerSrf([SquareSizePxl As Long = 8], [BackColor As Long = 16777215], [SquareColor As Long], [SquareAlpha As Double = 0,2]) As cCairoSurface
Member of RC6.cCairo

It returns a cCairoSurface but does neither require a cCairoSurface template to know the width and height nor does it accept width and height.
Also I didn't find cCairoSurface.resize or .rescale.

It's good to do all of your alpha work/layering/compositing within Cairo and then render the final result to the VB/Windows-side hDC. For example:

Code:

---

  Dim CroppedSrf As RC6.cCairoSurface
 
  ' Create surface image with the transparent border pixels cropped
  Set CroppedSrf = CropToCairoSurface(Cairo.CreateSurface(0, 0, , m_PngBytesBgRemoved))
 
  ' Create a surface the size of the form
  With Cairo.CreateSurface(Me.ScaleWidth, Me.ScaleHeight)
      With .CreateContext
        .Paint , Cairo.CreateCheckerPattern ' Fill surface with the checkboard pattern
        .RenderSurfaceContent CroppedSrf, 0, 0, .Surface.Width, .Surface.Height ' Draw the cropped main image over top, honouring transparency
      End With
     
      .DrawToDC Me.hDC, 0, 0, Me.ScaleWidth, Me.ScaleHeight ' Draw everything to the form hDC
  End With

---