I have created a cCairoSurface from bytes like this:
Next, I crop it so that all outer transparent pixels are gone:
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:
Here are the helper functions:
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.
Code:
Dim s As cCairoSurface
Set s = modCairo.CairoSurfaceFromBytes(m_PngBytesBGRemoved)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 FunctionI 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 SubCode:
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 FunctionI 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.