-
Feb 2nd, 2024, 02:19 PM
#1
Thread Starter
Hyperactive Member
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.
Last edited by tmighty2; Feb 2nd, 2024 at 03:42 PM.
-
Feb 2nd, 2024, 05:31 PM
#2
Re: RichClient: CairoSurface
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
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|