Results 1 to 2 of 2

Thread: RichClient: CairoSurface

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2017
    Posts
    344

    Question 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.

  2. #2
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    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
  •  



Click Here to Expand Forum to Full Width