VB6 Cairo-Paths and Projections

[Schmidt]

The Demo shows, how to create Path-Objects via simple helper-functions (of return-type cCairoPath) -
and how to "Append" and then "Stroke" these Paths via similar named methods on a cCairoContext.

I guess, this is also a topic for "Makers" (Laser-Cutting, 3D-Printing)...

Simple Path-construction-functions as e.g.:
- a path for a single tooth of a gear (or its horizontal expansion via loop)
- or a single path for a curve, or a circle
are relatively easy to "code by hand".

But what if e.g. a "horizontal line of teeth" (as used on a "rack") needs to follow a curved- or circular track?
Such "combined complex paths" are difficult to "define by hand" -
and that's where the second part of the Demo comes into play:
showing how one can project one path in a way, so that it "follows" another Path.

E.g. if you look at the 1st ScreenShot here, which shows the Demo after it was just starting up:
(showing the "yet un-projected two Paths" which we've generated, a "horizontal line of teeths" and "a circle"):


Ok, now - with a single Method-call (ProjectPathData) on the cairo-context, we can combine the two paths
(producing a combined path for a "42-teeth-gear"):


Third and last image is just showing, that any (horizontally designed) Path-Renderings -
can be projected onto any other (arbitrary) path or curve.


Here is the code for a single (empty) Form-Project (which needs a reference to RC6):

Option Explicit

Const TeethCount = 42, TeethHeight = 5, SinglePeriodDistance = 12

Private CC As cCairoContext, WithEvents Btn As VB.CommandButton
 
Private Sub Form_Load()
  Set Btn = Controls.Add("VB.CommandButton", "Btn") 'add a checkbox dynamically
      Btn.Caption = "Project teeth to circular Path": Btn.Visible = 1
      
  Move Left, Top, ScaleX(590, vbPixels, vbTwips), ScaleY(320, vbPixels, vbTwips)
End Sub

Private Sub Form_Resize() 'the usual lines, to keep CC as a "Form-covering-context
  ScaleMode = vbPixels: Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
  RefreshDrawings False
End Sub

Private Sub Btn_Click()
  RefreshDrawings
  Btn.Caption = "Project teeth to " & IIf(InStr(Btn.Caption, "curved"), "circular Path", "curved Path")
End Sub

Private Sub RefreshDrawings(Optional ByVal UseProjection As Boolean = True)
   CC.Paint 1, Cairo.CreateCheckerPattern
   
   Dim PPath As cCairoPath: Set PPath = CreateProjectionPath()
   Dim TPath As cCairoPath: Set TPath = CreateTeethPath()
   
   If UseProjection Then TPath.ProjectPathData_Using PPath '<- here's where the magic happens (TPath will now "follow along" PPath)

   CC.Save '<- isolates the render-output of our two paths...
     CC.TranslateDrawings 55, 55 '...because we use a transform (here only, to provide some shifting)
     
     RenderStrokedPath PPath, 1, vbBlue
     RenderStrokedPath TPath, 2, vbRed
   CC.Restore
   
   Set Picture = CC.Surface.Picture
End Sub

Sub RenderStrokedPath(Path As cCairoPath, Optional ByVal LineWidth& = 1, Optional ByVal Color&)
  CC.AppendPath Path 'add the Projection-Path to the context
  CC.SetLineWidth LineWidth
  CC.Stroke , Cairo.CreateSolidPatternLng(Color)
End Sub

Function CreateProjectionPath() As cCairoPath
  Dim PC As cCairoContext
  Set PC = Cairo.CreateSurface(1, 1).CreateContext 'ensure a "Projection-Context"
  
  If InStr(Btn.Caption, "curved") Then
    PC.CurveTo 0, 0, 90, 0, 190, 120
    PC.RelCurveTo 120, 150, 90, 0, 190, -66
  Else
    PC.Arc 80, 100, (TeethCount * SinglePeriodDistance) / (2 * Cairo.PI)
  End If

  Set CreateProjectionPath = PC.CopyPath(True) 'return the resulting path
End Function

Function CreateTeethPath(Optional ByVal StepsPerToothPeriod& = 32) As cCairoPath
  Dim PC As cCairoContext, i As Long, j As Long, x As Double, y As Double
  Set PC = Cairo.CreateSurface(1, 1).CreateContext 'ensure a "Projection-Context"
  
  PC.MoveTo 0, 0 'ensure a valid starting-point for the (horizontal to the right) teeth-renderings
  
  For i = 1 To TeethCount 'repeat the whole thing, according to our TeethCount-constant
      AddSingleToothTo PC, x, y, StepsPerToothPeriod
  Next
  
  Set CreateTeethPath = PC.CopyPath(True) 'return the resulting path
End Function

Sub AddSingleToothTo(PC As cCairoContext, x, y, StepsPerToothPeriod)
  Dim i As Long
  For i = 1 To StepsPerToothPeriod 'this loop is a generator for a simpe, single "SinusTooth"
      x = x + SinglePeriodDistance / StepsPerToothPeriod
      y = Sin(i / StepsPerToothPeriod * 2 * Cairo.PI) * TeethHeight
      PC.LineTo x, -y
  Next
End Sub

Have fun,

Olaf

[JT870]

It's great! Olaf, you always keep the codes efficient!
Two question, how about the projection precision. I mean : 1)Is the tooth center line always kept as the exact normal line of the circular path?
2)Is not any deformation for the tooth itsself at any projection point?

Thanks .
John

[Schmidt]

It's great! Olaf, you always keep the codes efficient!
Two question, how about the projection precision. I mean : 1)Is the tooth center line always kept as the exact normal line of the circular path?
2)Is not any deformation for the tooth itsself at any projection point?

An y=0 coord in the "teeth-path" will sit exatly at the center of the "projection-path".

Y-Values which differ from zero, will be projected to the in- or outside of the projection-path, depending on their sign.

The projection-algo does all this, based on the Normal-Vector (whilst walking the projection-path in "x-Direction").
(the Normal-Vector is the one, which sits perpendicular to the tangent at any point on the projection-path).

So yes, a "perfectly symmetrical tooth" (when viewed in "horizontal mode" +y/-y wise),
will be deformed when the projection-path has "narrow curve-radii".

The question is, whether this is not exactly what is wanted/needed in some scenarios...
It is certainly not when you use an involute-tooth-formula... (because this incorporates inner and outer radii already) -
so in this case you should not use a projection, but a "transform-rotate", before appending the next tooth on e.g. a circle-cirumference.

FWIW, here is a changed version, which shows the deformation more clearly -
but also shows, that this deformation is not affecting the y-distance of "projected points" -
(to the inside and outside of the projection-path).

Option Explicit

Const TeethCount = 12, TeethHeight = 16, SinglePeriodDistance = 42

Private CC As cCairoContext, WithEvents Btn As VB.CommandButton
 
Private Sub Form_Load()
  Set Btn = Controls.Add("VB.CommandButton", "Btn") 'add a checkbox dynamically
      Btn.Caption = "Project teeth to circular Path": Btn.Visible = 1
      
  Move Left, Top, ScaleX(590, vbPixels, vbTwips), ScaleY(320, vbPixels, vbTwips)
End Sub

Private Sub Form_Resize() 'the usual lines, to keep CC as a "Form-covering-context
  ScaleMode = vbPixels: Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
  RefreshDrawings False
End Sub

Private Sub Btn_Click()
  RefreshDrawings
  Btn.Caption = "Project teeth to " & IIf(InStr(Btn.Caption, "curved"), "circular Path", "curved Path")
End Sub

Private Sub RefreshDrawings(Optional ByVal UseProjection As Boolean = True)
   CC.Paint 1, Cairo.CreateCheckerPattern(, , &HCCCCCC)
   
   Dim PPath As cCairoPath: Set PPath = CreateProjectionPath()
   Dim TPath As cCairoPath: Set TPath = CreateTeethPath()
   
   If UseProjection Then TPath.ProjectPathData_Using PPath '<- here's where the magic happens (TPath will now "follow along" PPath)

   CC.Save '<- isolates the render-output of our two paths...
     CC.TranslateDrawings 55, 55 '...because we use a transform (here only, to provide some shifting)
     CC.SetLineJoin CAIRO_LINE_JOIN_ROUND
     CC.SetLineCap CAIRO_LINE_CAP_ROUND
     
     RenderStrokedPath PPath, 1, vbBlue
     RenderStrokedPath TPath, 2, vbRed
     
     If InStr(Btn.Caption, "circular") Then
        CC.SetLineWidth 0.7
        CC.Arc 80, 100, (TeethCount * SinglePeriodDistance) / (2 * Cairo.PI) - TeethHeight
        CC.Arc 80, 100, (TeethCount * SinglePeriodDistance) / (2 * Cairo.PI) + TeethHeight
        CC.Stroke , Cairo.CreateSolidPatternLng(vbGreen)
     End If
   CC.Restore
   
   Set Picture = CC.Surface.Picture
End Sub

Sub RenderStrokedPath(Path As cCairoPath, Optional ByVal LineWidth& = 1, Optional ByVal Color&)
  CC.AppendPath Path 'add the Projection-Path to the context
  CC.SetLineWidth LineWidth
  CC.Stroke , Cairo.CreateSolidPatternLng(Color)
End Sub

Function CreateProjectionPath() As cCairoPath
  Dim PC As cCairoContext
  Set PC = Cairo.CreateSurface(1, 1).CreateContext 'ensure a "Projection-Context"
  
  If InStr(Btn.Caption, "curved") Then
    PC.CurveTo 0, 0, 90, 0, 190, 120
    PC.RelCurveTo 120, 150, 90, 0, 190, -66
  Else
    PC.Arc 80, 100, (TeethCount * SinglePeriodDistance) / (2 * Cairo.PI)
  End If

  Set CreateProjectionPath = PC.CopyPath(True) 'return the resulting path
End Function

Function CreateTeethPath(Optional ByVal StepsPerToothPeriod& = 64) As cCairoPath
  Dim PC As cCairoContext, i As Long, j As Long, x As Double, y As Double
  Set PC = Cairo.CreateSurface(1, 1).CreateContext 'ensure a "Projection-Context"
  
  PC.MoveTo 0, 0 'ensure a valid starting-point for the (horizontal to the right) teeth-renderings
  
  For i = 1 To TeethCount 'repeat the whole thing, according to our TeethCount-constant
      AddSingleToothTo PC, x, y, StepsPerToothPeriod
  Next
  
  Set CreateTeethPath = PC.CopyPath(True) 'return the resulting path
End Function

Sub AddSingleToothTo(PC As cCairoContext, x, y, StepsPerToothPeriod)
  Dim i As Long
  For i = 1 To StepsPerToothPeriod 'this loop is a generator for a simpe, single "SinusTooth"
      x = x + SinglePeriodDistance / StepsPerToothPeriod
      y = Sin(i / StepsPerToothPeriod * 2 * Cairo.PI) * TeethHeight
      PC.LineTo x, -y
  Next
End Sub

[JT870]

Many thanks, Olaf. I want to simulate a harmonic drive movement, so when a wave generator ( as a rigid teeth path) rotates 360 degs, maybe the flex spliner rotates 3.6 degs along reversly along the wave generator path.,which means the teeth on the flex spliner will re-array again and again. I made a quite complex mathmatical calcualtion to do the job,the speed is quite slow. That's why I want to do it with Cairo method. well , it seems not as easy as i thought. anyway, thanks again.

John

[tmighty2]

I am currently using a newbie approach to paint a circle which closes more and more. At 0%, it should not be visible, at 50% it should be half closed, and at 100% it should be fully closed.

I paint this circle over keys on a virtual keyboard (in this case, over the "I" key) to indicate how long the mouse pointer has been over this key already since after X milliseconds, the key will automatically be clicked (this is for handicapped users who can't press down the mouse buttons by themselves.

My current approach "jitters". I am unable to keep start of the circle at the same position at each rendering. I tried a lot but didn't get it to work. Last night I dreamt about cairo which I never used. This morning, I took a look and saw that it is really powerful, and I would like to switch if possible.

Here is what I do with a custom GDI+ word art path created by LaVolpe:

      Dim n As clsWApath
    Set n = New clsWApath
    
    Dim lWidth&
    Dim lHeight&
    lWidth = uRight - uLeft
    lHeight = uBottom - uTop
    
    Dim lSize&
    If lWidth > lHeight Then
        lSize = lHeight
    Else
        lSize = lWidth
    End If
    
    Dim lOffLeft&
    lOffLeft = (lWidth - lSize) \ 2
    
    Dim lOffTop&
    lOffTop = (lHeight - lSize) \ 2
    
    Dim lPenWidth&
    lPenWidth = 50
    
    Dim lRenderLeft&
    Dim lRenderTop&
    lRenderLeft = uLeft + lOffLeft + (lPenWidth / 2)
    lRenderTop = uTop + lOffTop + (lPenWidth / 2)
        
    With n
    
        Call .Append_Arc(0, 0, lSize - lPenWidth, lSize - lPenWidth, 0, (uHotValue * 3.6))
    
        With .brush("Border")
            .SetOutlineAttributes vbRed, 50, lPenWidth, DashStyleSolid
        End With
    
        'At 0%, it is not known how big the circle will be, so we offset the circle manually. I guess this is what introduces a jitter
        Call .OverrideWorldTransform(0, 0, 0, 0, lRenderLeft, lRenderTop)
        
        .Render uBitmapToDrawOnto, lRenderLeft, lRenderTop
    End With

I have gone throught the cairo tutorial but (apart from other great demos) didn't see any tutorial that would fit my needs.
Where should I look for that?

[Schmidt]

I have gone throught the cairo tutorial but (apart from other great demos) didn't see any tutorial that would fit my needs.
Where should I look for that?

There's quite a lot of stuff to find via google-search (with site-specification):
[ site:vbForums.com cairo schmidt Your Other SearchTerms ]

Not sure what you really need in the end, but JPBro made a nice circular Progress-Class:
https://www.vbforums.com/showthread....-vbRichClient5
which can be adapted to RC6, when you change project-references -
and do a global string-replace on the projectcode from vbRichClient5 to RC6 via Find/Replace

There's other demos, where "circular patterns" via cairo were addressed:
- as e.g. the last post #19 here: https://www.vbforums.com/showthread....=1#post4903549
- or "a clocks-demo": https://www.vbforums.com/showthread....wn-ClockHands)

But perhaps this simple one is already sufficient (Form-code):

Option Explicit

Private CC As cCairoContext ' the drawing-context (derived from a Cairo-Surface)
Private WithEvents tmrRefresh As cTimer 'a refresh-timer
Private CurChar As String, Degree As Double 'current char and the Degree-Counter
 
Private Sub Form_Resize() 'ensure a Form-covering BackBuffer.(Context)
  ScaleMode = vbPixels 'because cairo works in Pixels as well
  Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
  Caption = "Press a Key...": Redraw
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  CurChar = UCase$(ChrW$(KeyAscii)): Degree = 0 'reset when a new Key comes in
  Set tmrRefresh = New_c.Timer(40, True)
End Sub

Private Sub tmrRefresh_Timer()
  Degree = Degree + 2 'increment the Degree-Counter
  If Degree > 360 Then
     Caption = "Time is up": Set tmrRefresh = Nothing: Beep
  Else
     Caption = Format(Degree / 360, "Percent"): Redraw
  End If
End Sub

Private Sub Redraw()
  Const Deg2Rad = 1.74532925199433E-02
  CC.Paint 1, Cairo.CreateCheckerPattern(8, &H444444) 'erase (overpaint) the last content with a new BackGround
  
  CC.SelectFont "Arial", 99, vbMagenta, True 'drawing centered Text is easy via CC.DrawText (using HAlign=vbCenter and Valign=1)
  CC.DrawText 0, 0, CC.Surface.Width, CC.Surface.Height, CurChar, True, vbCenter, 2, 1
  
  CC.Save 'store the current state (since we use a coordsystem-shift below (on the Form-covering CC.Surface)
    CC.TranslateDrawings CC.Surface.Width / 2, CC.Surface.Height / 2 'the new coord(0,0) is now at the center

    CC.Arc 0, 0, 111, 0, Degree * Deg2Rad 'define a circular path with an "inner Radius" (starting at origin-angle 0)
    CC.ArcNegative 0, 0, 222, Degree * Deg2Rad, 0 'define a circular path with an "outer Radius" (moving back to the origin-angle 0)
    CC.Fill , Cairo.CreateSolidPatternLng(vbGreen, 0.4) 'fill the double-arced path with 40%-Alpha
  CC.Restore 'and we're done (can reset to the former state of the CC)
  
  CC.Surface.DrawToDC hDC 'render the result of the BackBuf-Surface to the Form
End Sub

The above producing:


HTH

Olaf

[tmighty2]

This is great, thank you.
I was expecting that the following would erase everything and leave me with a transparent background as alpha is 0.

CC.Paint 1, Cairo.CreateSolidPattern(255, 0, 0, 0)

But it seems that I loose the transparency when I do that. It looks like that:

Attachment 187510

This is my entire code. Thank you!

Option Explicit

Private CC As cCairoContext ' the drawing-context (derived from a Cairo-Surface)
Private WithEvents tmrRefresh As cTimer 'a refresh-timer
Private CurChar As String, Degree As Double 'current char and the Degree-Counter
 
Private Sub Form_Resize() 'ensure a Form-covering BackBuffer.(Context)
  ScaleMode = vbPixels 'because cairo works in Pixels as well
  Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
  Caption = "Press a Key...": Redraw
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  CurChar = UCase$(ChrW$(KeyAscii)): Degree = 0 'reset when a new Key comes in
  Set tmrRefresh = New_c.Timer(40, True)
End Sub

Private Sub tmrRefresh_Timer()
  Degree = Degree + 2 'increment the Degree-Counter
  If Degree > 360 Then
     Caption = "Time is up": Set tmrRefresh = Nothing: Beep
  Else
     Caption = Format(Degree / 360, "Percent"): Redraw
  End If
End Sub

Private Sub Redraw()

    Const Deg2Rad = 1.74532925199433E-02
    ' CC.Paint 1, Cairo.CreateCheckerPattern(8, &H444444)  'erase (overpaint) the last content with a new BackGround
    CC.Paint 1, Cairo.CreateSolidPattern(255, 0, 0, 0)
    
    CC.SelectFont "Arial", 99, vbMagenta, True 'drawing centered Text is easy via CC.DrawText (using HAlign=vbCenter and Valign=1)
    CC.DrawText 0, 0, CC.Surface.Width, CC.Surface.Height, CurChar, True, vbCenter, 2, 1
    
    CC.Save 'store the current state (since we use a coordsystem-shift below (on the Form-covering CC.Surface)
    CC.TranslateDrawings CC.Surface.Width / 2, CC.Surface.Height / 2 'the new coord(0,0) is now at the center
    
    CC.Arc 0, 0, 111, 0, Degree * Deg2Rad 'define a circular path with an "inner Radius" (starting at origin-angle 0)
    CC.ArcNegative 0, 0, 222, Degree * Deg2Rad, 0 'define a circular path with an "outer Radius" (moving back to the origin-angle 0)
    CC.Fill , Cairo.CreateSolidPatternLng(vbGreen, 0.4) 'fill the double-arced path with 40%-Alpha
    CC.Restore 'and we're done (can reset to the former state of the CC)
    
    CC.Surface.DrawToDC hDC 'render the result of the BackBuf-Surface to the Form
    
    Me.Refresh
End Sub

[tmighty2]

----

[Schmidt]

This is great, thank you.
I was expecting that the following would erase everything and leave me with a transparent background as alpha is 0.

CC.Paint 1, Cairo.CreateSolidPattern(255, 0, 0, 0)

To clear an entire surface to "full transparency" one can use the sequence:

  CC.Operator = CAIRO_OPERATOR_CLEAR
    CC.Paint
  CC.Operator = CAIRO_OPERATOR_OVER 'reset to the default-operator

Though keep in mind, that (when the target is a VB-Form and not "a Cairo-WidgetForm" or "a Cairo-Widget") -
the Alpha-BackGround is not correctly transported when you finally call:
CC.Surface.DrawToDC Me.hDC

In case you want to render the BackBuffer-Alpha-Contents to a BackGround-Image which is already set on the Form,
you should render the same Form-BG-Image as the BackGround of the BackBuffer first.

HTH

Olaf

[tmighty2]

I am trying to draw on to a c32bppdib section which I create like this (code is from LaVolpe).
I use this c32bppdib section throughout my entire app. I want to, but I am still afraid to replace it everywhere in my app with a cairo surface even though half of my app is based on your work already.
However, when I call CC.Surface.DrawToDC myccbppdib.hdc then it paints the background white.
Do you have any idea why this is happening and how to change it?

This is what such a c32bppdib section is created:

Public Function InitializeDIB(ByVal Width As Long, ByVal Height As Long) As Boolean

    ' Purpose: create a blank (all black, all transparent) DIB of requested height & width
    
    Dim tBMPI As BITMAPINFO, tDC As Long
    
    DestroyDIB ' clear any pre-existing dib
    
    If Width < 0& Then Exit Function
    If Height = 0& Then
        Exit Function
    ElseIf Height < 0& Then
        Height = Abs(Height) ' no top-down dibs
    End If
    
    On Error Resume Next
    With tBMPI.bmiHeader
        .biBitCount = 32
        .biHeight = Height
        .biWidth = Width
        .biPlanes = 1
        .biSize = 40&
        .biSizeImage = .biHeight * .biWidth * 4&
    End With
    If Err Then
        Err.Clear
        ' only possible error would be that Width*Height*4& is absolutely huge
        Exit Function
    End If
    
    tDC = GetDC(0&) ' get screen DC
    m_Handle = CreateDIBSection(tDC, tBMPI, 0&, m_Pointer, 0&, 0&)
    If m_ManageDC = True Then
        ' create a DC if class is managing its own & one isn't created yet
        If m_hDC = 0& Then m_hDC = CreateCompatibleDC(tDC)
    End If
    ' release the screen DC if we captured it
    ReleaseDC 0&, tDC
    
    If Not m_Handle = 0& Then    ' let's hope system resources allowed DIB creation
        m_Width = Width
        m_Height = Height
        EraseDIB                ' have experienced new dib filled with non-zeroes. Zero it out
        InitializeDIB = True
    End If

End Function

[tmighty2]

Edit: But when the surface out as a png, it looks perfectly fine:

CC.Surface.WriteContentToPngFile "d:\test.png"

Attachment 187517

[tmighty2]

Attachment 187518

Could you also tell me how to make such a shrinking circle?

[Schmidt]

Edit: But when the surface out as a png, it looks perfectly fine:

CC.Surface.WriteContentToPngFile "d:\test.png"

That's because it *is* fine...

If you work with LaVolpes c32bppDIB in your Project -
you can basically make a direct MemCopy of the Pixel-allocations
from a cCairoSurface to c32bppDIB (they both use BGRA with pre-multiplied Alpha).

The only fly in the ointment is, that LaVolpes class has a Bottom-Up memory-layout -
so instead of being able to copy the contents in a single line of code,
we have to implement a little loop to copy the contents "row-by-row".

This is shown in the little Helper-Function at the end of this Demo-Code:

Option Explicit

Private CC As cCairoContext ' the drawing-context (derived from a Cairo-Surface)
Private WithEvents tmrRefresh As cTimer 'a refresh-timer
Private CurChar As String, Degree As Double 'current char and the Degree-Counter
 
Private Sub Form_Resize() 'ensure a Form-covering BackBuffer.(Context)
  AutoRedraw = True: ScaleMode = vbPixels 'because cairo works in Pixels as well
  Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
  Caption = "Press a Key...": Redraw
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  CurChar = UCase$(ChrW$(KeyAscii)): Degree = 0 'reset when a new Key comes in
  Set tmrRefresh = New_c.Timer(15, True)
End Sub

Private Sub tmrRefresh_Timer()
  Degree = Degree + 2 'increment the Degree-Counter
  If Degree > 360 Then
     Caption = "Time is up": Set tmrRefresh = Nothing: Beep
  Else
     Caption = Format(Degree / 360, "Percent"): Redraw
  End If
End Sub

Private Sub Redraw()
  Const Deg2Rad = 1.74532925199433E-02

  CC.Operator = CAIRO_OPERATOR_CLEAR
    CC.Paint
  CC.Operator = CAIRO_OPERATOR_OVER 'reset to the default-operator

  CC.SelectFont "Arial", 99, vbMagenta, True 'drawing centered Text is easy via CC.DrawText (using HAlign=vbCenter and Valign=1)
  CC.DrawText 0, 0, CC.Surface.Width, CC.Surface.Height, CurChar, True, vbCenter, 2, 1
  
  CC.Save 'store the current state (since we use a coordsystem-shift below (on the Form-covering CC.Surface)
    CC.TranslateDrawings CC.Surface.Width / 2, CC.Surface.Height / 2 'the new coord(0,0) is now at the center

    CC.Arc 0, 0, 111, 0, Degree * Deg2Rad 'define a circular path with an "inner Radius" (starting at origin-angle 0)
    CC.ArcNegative 0, 0, 222, Degree * Deg2Rad, 0 'define a circular path with an "outer Radius" (moving back to the origin-angle 0)
    CC.Fill , Cairo.CreateSolidPatternLng(vbGreen, 0.4) 'fill the double-arced path with 40%-Alpha
  CC.Restore 'and we're done (can reset to the former state of the CC)
  
  Me.Cls
    Dim DIB32 As c32bppDIB
    Set DIB32 = CreateDIB32FromSurface(CC.Surface)
        DIB32.Render Me.hDC
  If Me.AutoRedraw Then Me.Refresh
  
'  CC.Surface.DrawToDC hDC 'render the result diectly from the BackBuf-Surface to the Form
End Sub

Public Function CreateDIB32FromSurface(Srf As cCairoSurface) As c32bppDIB
  Set CreateDIB32FromSurface = New c32bppDIB
      CreateDIB32FromSurface.InitializeDIB Srf.Width, Srf.Height
   
   Dim pSrc As Long: pSrc = Srf.DataPtr + (Srf.Height - 1) * Srf.Stride 'init Src-pointer to the last row
   Dim pDst As Long: pDst = CreateDIB32FromSurface.BitsPointer '... and Dst-Pointer to the first row
   'now we have to do Bottom-Up-row-copying from the Source (because c32bppDIB prefers a Bottom-Up memory-layout in its internal allocation)
   Do: New_c.MemCopy pDst, pSrc, Srf.Stride
       pSrc = pSrc - Srf.Stride: pDst = pDst + Srf.Stride
   Loop Until pSrc < Srf.DataPtr
End Function

As for your other question - I don't see any of your uploaded Image-attachments.
To avoid this "Forum-bug", you have to switch to "Go Advanced" mode before you send your replies
(in case they shall contain Image-Uploads).

Olaf

[tmighty2]

There is the type drawing that I would like to do.
The more time the users spends over the button, the more the hole will close.

[tmighty2]

This works flawlessly. Thank you!

[tmighty2]

This video shows the different states of the button
I wonder how this is done. By masking?

[Schmidt]

This video shows the different states of the button: https://www.youtube.com/watch?v=AlqPYTNH8gk
I wonder how this is done. By masking?

Since you already have cairo-code (for drawing a hollowed-out circle) from the previous example -
it shouldn't be that hard to exchange the "variable circumference-angle" from before -
to a "variable inner Radius" (hardwiring the circumference-angles to "2 * PI" == "full circle").

Option Explicit

Private CC As cCairoContext ' the drawing-context (derived from a Cairo-Surface)
Private WithEvents tmrRefresh As cTimer 'a refresh-timer
Private InnerRadius As Double
 
Private Sub Form_Resize() 'ensure a Form-covering BackBuffer.(Context)
  AutoRedraw = True: ScaleMode = vbPixels 'because cairo works in Pixels as well
  Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
  Caption = "Click Me"
End Sub

Private Sub Form_Click()
  InnerRadius = IIf(ScaleWidth < ScaleHeight, ScaleWidth, ScaleHeight) / 2
  Set tmrRefresh = New_c.Timer(15, True)
End Sub

Private Sub tmrRefresh_Timer()
  InnerRadius = InnerRadius - 2 'decrement the inner radius
  If InnerRadius < 0 Then
     Caption = "Time is up": Set tmrRefresh = Nothing: Beep
  Else
     Redraw
  End If
End Sub

Private Sub Redraw()
  CC.Operator = CAIRO_OPERATOR_CLEAR
    CC.Paint
  CC.Operator = CAIRO_OPERATOR_OVER 'reset to the default-operator
 
  CC.Save 'store the current state (since we use a coordsystem-shift below (on the Form-covering CC.Surface)
    CC.TranslateDrawings CC.Surface.Width / 2, CC.Surface.Height / 2 'the new coord(0,0) is now at the center

    CC.Arc 0, 0, InnerRadius, 0, 2 * Cairo.PI 'define a circular path with an "inner Radius" (starting at origin-angle 0)
    CC.ArcNegative 0, 0, 3333, 2 * Cairo.PI, 0 'define a circular path with an "outer Radius" (moving back to the origin-angle 0)
    CC.Fill , Cairo.CreateSolidPatternLng(vbRed, 0.4) 'fill the double-arced path with 40%-Alpha
  CC.Restore 'and we're done (can reset to the former state of the CC)
  
  CC.Surface.DrawToDC hDC 'render the result diectly from the BackBuf-Surface to the Form
  If AutoRedraw Then Refresh
End Sub

Olaf

[tmighty2]

Wonderful!! Thank you. It looks so good!

[tmighty2]

How could I draw a closing cake instead of a closing circle?

My current code does not work, and my understanding of geometry is quite limited:

Thank you.

Private Sub pDrawHotValueCake(ByVal uBitmapToDrawOnto As Long, ByVal uHotValue As Byte, ByVal uLeft As Long, ByVal uTop As Long, ByVal uRight As Long, ByVal uBottom As Long)
On Error GoTo ErrHandler

    Dim lWidth As Long
    Dim lHeight As Long
    lWidth = uRight - uLeft
    lHeight = uBottom - uTop
    
    Dim bRecreate As Boolean
    bRecreate = False
    
    Dim lSize As Long
    If lWidth > lHeight Then
        lSize = lHeight
    Else
        lSize = lWidth
    End If
    
    If CC Is Nothing Then
        bRecreate = True
    Else
        bRecreate = (CC.Surface.Width <> lSize) Or (CC.Surface.Height <> lSize)
    End If
    
    If bRecreate Then
        Set CC = Cairo.CreateSurface(lSize, lSize).CreateContext
    End If
    
    Dim lOffLeft As Long
    lOffLeft = (lWidth - lSize) \ 2
    
    Dim lOffTop As Long
    lOffTop = (lHeight - lSize) \ 2
    
    Dim lPenWidth As Long
    lPenWidth = 50
    
    Dim lRenderLeft As Long
    Dim lRenderTop As Long
    lRenderLeft = uLeft + lOffLeft + (lPenWidth / 2)
    lRenderTop = uTop + lOffTop + (lPenWidth / 2)
    
    Dim lColor As Long
    lColor = vbRed
    
    Dim Degree As Double
    Degree = (uHotValue / 100) * 360
    
    CC.Operator = CAIRO_OPERATOR_CLEAR
    CC.Paint
    CC.Operator = CAIRO_OPERATOR_OVER 'reset to the default-operator
    
    CC.Save 'store the current state (since we use a coordsystem-shift below (on the Form-covering CC.Surface)
    CC.TranslateDrawings CC.Surface.Width / 2, CC.Surface.Height / 2 'the new coord(0,0) is now at the center
    
    Dim curChar As String
    Const Deg2Rad As Double = 1.74532925199433E-02
    
    curChar = "b"
    CC.SelectFont "Arial", 99, vbMagenta, True 'drawing centered Text is easy via CC.DrawText (using HAlign=vbCenter and Valign=1)
    CC.DrawText 0, 0, CC.Surface.Width, CC.Surface.Height, curChar, True, vbCenter, 2, 1
    
    Dim radius As Double
    radius = lSize / 3
    
    Dim startAngle As Double
    startAngle = 0
    
    Dim endAngle As Double
    endAngle = Degree * Deg2Rad
    
    CC.Operator = CAIRO_OPERATOR_CLEAR
    CC.ArcNegative 0, 0, radius, endAngle, startAngle
    CC.LineTo 0, 0
    CC.Operator = CAIRO_OPERATOR_OVER
    
    CC.Fill , Cairo.CreateSolidPatternLng(lColor, 0.9) ' Fill the cake slice with 40% alpha
    

    Dim DIB32 As c32bppDIB
    Set DIB32 = CreateDIB32FromSurface(CC.Surface)
    DIB32.Render uBitmapToDrawOnto, lRenderLeft, lRenderTop

Exit Sub
ErrHandler:
Debug.Print Err.Description
Debug.Assert False
Call modLog.WriteLog("#clsButton_pDrawHotValueCake: " & Err.Description & ", err.number: " & Err.Number & ", Params: '" & "" & "'")
End Sub

[Schmidt]

How could I draw a closing cake instead of a closing circle?

Don't know...
What does "a closing cake" look like?

Olaf

[tmighty2]

I had posted a picture. :-)

At "HotValue" 100, the cake should be full, at hotvalue 50, the cake should be half-eaten, at hotvalue 0, the cake should not be shown.

[Schmidt]

I had posted a picture. :-)

At "HotValue" 100, the cake should be full, at hotvalue 50, the cake should be half-eaten, at hotvalue 0, the cake should not be shown.

Option Explicit

Private CC As cCairoContext ' the drawing-context (derived from a Cairo-Surface)
Private WithEvents tmrRefresh As cTimer 'a refresh-timer
Private Perc As Double
 
Private Sub Form_Resize() 'ensure a Form-covering BackBuffer.(Context)
  AutoRedraw = True: ScaleMode = vbPixels 'because cairo works in Pixels as well
  Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
  Caption = "Click Me"
End Sub

Private Sub Form_Click()
  Perc = 0
  Set tmrRefresh = New_c.Timer(15, True)
End Sub

Private Sub tmrRefresh_Timer()
  Perc = Perc + 1 'increment the percents
  If Perc > 100 Then
     Caption = "Time is up": Set tmrRefresh = Nothing: Beep
  Else
     pDrawHotValueCake Perc, 0, 0, CC.Surface.Width, CC.Surface.Height
  End If
End Sub
 
Private Sub pDrawHotValueCake(ByVal uHotValue As Byte, ByVal uLeft As Long, ByVal uTop As Long, ByVal uRight As Long, ByVal uBottom As Long)
    On Error GoTo ErrHandler
  
    Dim lWidth As Long:   lWidth = uRight - uLeft
    Dim lHeight As Long:  lHeight = uBottom - uTop
    Dim lSize As Long:    lSize = IIf(lWidth > lHeight, lHeight, lWidth)
 
    If CC Is Nothing Then
      Set CC = Cairo.CreateSurface(lSize, lSize).CreateContext
    ElseIf CC.Surface.Width <> lSize Or CC.Surface.Height <> lSize Then
      Set CC = Cairo.CreateSurface(lSize, lSize).CreateContext
    End If
 
    CC.Operator = CAIRO_OPERATOR_CLEAR
      CC.Paint
    CC.Operator = CAIRO_OPERATOR_OVER 'reset to the default-operator
  
    DrawCenteredCake CC, lSize / 3, uHotValue / 100 * 2 * Cairo.PI, vbRed
 
    CC.Surface.DrawToDC hDC 'render the result diectly from the BackBuf-Surface to the Form
    If AutoRedraw Then Refresh
 
Exit Sub
ErrHandler: Debug.Print Err.Description
End Sub

Private Sub DrawCenteredCake(CC As cCairoContext, Radius, AngleRad, Color)
  CC.Save 'store the current state (since we use a coordsystem-shift and a rotation below)
    CC.TranslateDrawings CC.Surface.Width / 2, CC.Surface.Height / 2 'the new coord(0,0) is now at the center
    CC.RotateDrawingsDeg -90 'to let the angle start at the top
    
    CC.MoveTo 0, 0
    CC.Arc 0, 0, Radius, 0, AngleRad
    
    CC.Fill , Cairo.CreateSolidPatternLng(Color, 0.5) ' Fill the cake slice with 40% alpha
  CC.Restore
End Sub

It might help, when you split larger drawing-routines apart into smaller ones, like shown above.
Then the Save-Restore-pairs cannot be "messed up" as easily, since they "isolate" what's in the helper-routine.

Olaf

[tmighty2]

This is amazing!
Thank you!!

[tmighty2]

I am having a problem, but I don't see where I go wrong:

There must be a "/ 2" or "* 2" missing somewhere, but I don't see where.

The images show (from left to right) the shrinking circle at hotvalue 50, then at 70, then at 90.

The left image is definitively wrong:
At 50%, the circle should be half the width / height of the canvas. In my case however, it fills like 95% of the canvas.

What am I doing wrong?

Private Sub pDrawHotValueShrinkingIris(ByVal uBitmapToDrawOnto As Long, ByVal uHotValue As Long, ByVal uLeft As Long, ByVal uTop As Long, ByVal uRight As Long, ByVal uBottom As Long)
On Error GoTo ErrHandler

    Dim lWidth&
    Dim lHeight&
    lWidth = uRight - uLeft
    lHeight = uBottom - uTop
    
    Dim bRecreate As Boolean
    bRecreate = False

    Dim lSize&
    If lWidth > lHeight Then
        lSize = lWidth
    Else
        lSize = lHeight
    End If
    
    If InnerRadius = 0 Then
        InnerRadius = lSize
    End If

    InnerRadius = ((100 - uHotValue) / 100) * lSize
    
    
    ' (uHotValue / 100) * 360
    
     If CC Is Nothing Then
        bRecreate = True
    Else
        bRecreate = (CC.Surface.Width <> lSize) Or (CC.Surface.Height <> lSize)
    End If
    
    If bRecreate Then
        Set CC = Cairo.CreateSurface(lSize, lSize).CreateContext
    End If
    
    Dim lOffLeft&
    lOffLeft = (lWidth - lSize) \ 2

    Dim lOffTop&
    lOffTop = (lHeight - lSize) \ 2


    Dim lRenderLeft&
    Dim lRenderTop&
    lRenderLeft = uLeft + lOffLeft
    lRenderTop = uTop + lOffTop
    
    Dim lColor&
    lColor = User.Settings.DwellColor

    CC.Operator = CAIRO_OPERATOR_CLEAR
    CC.Paint
    CC.Operator = CAIRO_OPERATOR_OVER 'reset to the default-operator
    
    CC.Save 'store the current state (since we use a coordsystem-shift below (on the Form-covering CC.Surface)
    CC.TranslateDrawings CC.Surface.Width / 2, CC.Surface.Height / 2 'the new coord(0,0) is now at the center
    
    CC.Arc 0, 0, InnerRadius, 0, 2 * Cairo.PI 'define a circular path with an "inner Radius" (starting at origin-angle 0)
    CC.ArcNegative 0, 0, 3333, 2 * Cairo.PI, 0 'define a circular path with an "outer Radius" (moving back to the origin-angle 0)
    CC.Fill , Cairo.CreateSolidPatternLng(lColor, 0.9) 'fill the double-arced path with 40%-Alpha
    CC.Restore 'and we're done (can reset to the former state of the CC)


    Dim DIB32 As c32bppDIB
    Set DIB32 = CreateDIB32FromSurface(CC.Surface)
    DIB32.Render uBitmapToDrawOnto, lRenderLeft, lRenderTop
    
    If uHotValue > 5 Then
     '   DIB32.SaveToFile_PNG "d:\1.png"
    End If
    
Exit Sub
ErrHandler:
Debug.Print Err.Description
Debug.Assert False
Call modLog.WriteLog("#clsButton_pDrawHotValue: " & Err.Description & ", err.number: " & Err.Number & ", Params: '" & "" & "'")
End Sub

[tmighty2]

Ah, I got it:

InnerRadius = (((100 - uHotValue) / 100) * lSize) / 2

[Arnoutdv]

Jup, the radius is the distance from the center to the boundary of the circle. You where using the diameter of the circle.

[softv]

Dear Olaf,

Congratulations on releasing 6.0.13 of RC6 today (29-May-2023).

You have written "added a new Class: cSimplePSD, to parse Alpha-Layers into enumerable cairo-Surfaces directly from PhotoShop-*.psd files" in your "_Version-History" file. That's quite exciting and amazing. Thanks a TON. If and when possible, if you can share some code on how to show the different layers in a PSD file in different transparent images in a sample app, that would be much helpful. Thanks a ton in advance.



Kind Regards.

[tmighty2]

Attachment 187834

I would like to draw the remaining time for such a clock which shows handicapped users how much time is left for a task or until something is about to happen (for example how much time is left until lunch).

I can draw a cake with the mentioned code below, but I am not sure how I could transform the cake so that it is shown having the clocks's perspective.
How could I do that?

As you can see, my cake is drawn without any perspective.

Attachment 187835

Option Explicit

Private CC As cCairoContext ' the drawing-context (derived from a Cairo-Surface)

Private m_cClock           As New c32bppDIB

Private m_lClockSize&

Private m_cFinal As New c32bppDIB

Private m_lHour&
Private m_lMinute&
Private m_lSecond&

Private Function pCalculatedAngle() As Long

        pCalculatedAngle = Minute(Now) * 6
        
End Function

Public Function GetDib() As c32bppDIB

    Set GetDib = m_cFinal

End Function

Private Sub pPaint(ByVal hdc As Long, x As Long, y As Long, cX As Long, cY As Long)

    m_cFinal.EraseDIB

End Sub



Public Sub Refresh()

    Dim lHour&
    Dim lMinute&
    Dim lSecond&
    lHour = Hour(Now)
    lMinute = Minute(Now)
    lSecond = Second(Now)

    If Not m_cFinal Is Nothing Then
        If m_lHour = lHour Then
            If m_lMinute = lMinute Then
                If m_lSecond = lSecond Then
                    Exit Sub
                End If
            End If
        End If
    End If
    m_lHour = lHour
    m_lMinute = lMinute
    m_lSecond = lSecond

    Set m_cFinal = New c32bppDIB
    m_cFinal.InitializeDIB m_lClockSize, m_lClockSize
    
    Debug.Assert m_cFinal.Width = m_lClockSize
    
    m_cFinal.ManageOwnDC = True
    
    Dim lDib&
    lDib = m_cFinal.LoadDIBinDC(True)
    
    pDrawHotValueCake m_cFinal.hdc, 30, 0, 0, m_lClockSize, m_lClockSize

End Sub

Private Sub Class_Initialize()

    m_lClockSize = 374
    

End Sub
Private Sub DrawCenteredCake(CC As cCairoContext, Radius, AngleRad, Color)
  CC.Save 'store the current state (since we use a coordsystem-shift and a rotation below)
    CC.TranslateDrawings CC.Surface.Width / 2, CC.Surface.Height / 2 'the new coord(0,0) is now at the center
    CC.RotateDrawingsDeg -90 'to let the angle start at the top
    
    CC.moveTo 0, 0
    CC.Arc 0, 0, Radius, 0, AngleRad
    
    CC.Fill , Cairo.CreateSolidPatternLng(Color, 0.9) ' Fill the cake slice with 40% alpha
  CC.Restore
End Sub

Private Sub pDrawHotValueCake(ByVal uBitmapToDrawOnto As Long, ByVal uHotValue As Long, ByVal uLeft As Long, ByVal uTop As Long, ByVal uRight As Long, ByVal uBottom As Long)
On Error GoTo errhandler

    Dim lWidth As Long
    Dim lHeight As Long
    lWidth = uRight - uLeft + User.Settings.HotBorderWidth
    lHeight = uBottom - uTop + User.Settings.HotBorderWidth
    
    Dim bRecreate As Boolean
    bRecreate = False
    
    Dim lSize As Long
    If lWidth > lHeight Then
        lSize = lHeight
    Else
        lSize = lWidth
    End If
    
    If CC Is Nothing Then
        bRecreate = True
    Else
        bRecreate = (CC.Surface.Width <> lSize) Or (CC.Surface.Height <> lSize)
    End If
    
    If bRecreate Then
        Set CC = Cairo.CreateSurface(lSize, lSize).CreateContext
    End If
    
    CC.Operator = CAIRO_OPERATOR_CLEAR
    CC.Paint
    CC.Operator = CAIRO_OPERATOR_OVER 'reset to the default-operator
    
    Dim lOffLeft As Long
    lOffLeft = (lWidth - lSize) \ 2
    
    Dim lOffTop As Long
    lOffTop = (lHeight - lSize) \ 2
    
    Dim lPenWidth As Long
    lPenWidth = 50
    
    Dim lRenderLeft As Long
    Dim lRenderTop As Long
    lRenderLeft = uLeft + lOffLeft + (lPenWidth / 2)
    lRenderTop = uTop + lOffTop + (lPenWidth / 2)
    
    Dim lColor As Long
    lColor = User.Settings.DwellColor

    
    DrawCenteredCake CC, lSize / 3, uHotValue / 100 * 2 * Cairo.PI, lColor

    Dim DIB32 As c32bppDIB
    Set DIB32 = CreateDIB32FromSurface(CC.Surface)
    DIB32.Render uBitmapToDrawOnto, lRenderLeft, lRenderTop

    CC.Save

Exit Sub
errhandler:
Debug.Print Err.Description
Debug.Assert False
Call modLog.CriticalLog("#clsButton_pDrawHotValue: " & Err.Description & ", err.number: " & Err.Number & ", Params: '" & "" & "'")
End Sub
Public Function CreateDIB32FromSurface(Srf As cCairoSurface) As c32bppDIB
  Set CreateDIB32FromSurface = New c32bppDIB
      CreateDIB32FromSurface.InitializeDIB Srf.Width, Srf.Height
   
   Dim pSrc As Long: pSrc = Srf.DataPtr + (Srf.Height - 1) * Srf.stride 'init Src-pointer to the last row
   Dim pDst As Long: pDst = CreateDIB32FromSurface.BitsPointer '... and Dst-Pointer to the first row
   'now we have to do Bottom-Up-row-copying from the Source (because c32bppDIB prefers a Bottom-Up memory-layout in its internal allocation)
   Do: New_c.MemCopy pDst, pSrc, Srf.stride
       pSrc = pSrc - Srf.stride: pDst = pDst + Srf.stride
   Loop Until pSrc < Srf.DataPtr
End Function

[tmighty2]

I am using c32bpp dib, but I want to switch to the cairo equivalent, but I don't even manage to find the right name in the object explorer. I hate my brain.

I have not found anything for loading an image in cCairoContext.
I think cCairoSurface has something for me, but I don't find anything like Bytes or so.

I feel really stupid.
Can you anybody tell me how I would have found it or what you approached it?

[tmighty2]

I went through the RC5Cairo demo and shimmed through the 5 examples, but there was only imagelist loading.

[tmighty2]

Got it:

Private CC As cCairoContext ' the drawing-context (derived from a Cairo-Surface)
Private m_img As cCairoSurface

Set m_img = Cairo.CreateSurface(500, 500, ImageSurface, App.Path & "\clock.png")

[tmighty2]

Why does the cairo surface draw a black frame?
I have saved the cairo surface as a png file, and one can see the background is transparent.

To see what is going on here, I paint the form red before calling .DrawToDC.
I expect the clock to be shown on a red background.
But instead, it is drawn onto a blackground.

I have tried all available RasterOpConstants with the .DrawToDC function, but none did the job.

What am I missing?

Attachment 187881

Option Explicit

Private CC As cCairoContext ' the drawing-context (derived from a Cairo-Surface)
Private m_img As cCairoSurface
    

Private Sub Form_Load()

    Set m_img = Cairo.CreateSurface(500, 500, ImageSurface, App.Path & "\clock.png")
    
    Dim lSize&
    lSize = 500
    

End Sub

Private Sub Form_Resize()

    Me.Cls
    
    Dim lWidth&
    Dim lHeight&
    
    If Me.ScaleWidth < Me.ScaleHeight Then
        lWidth = Me.ScaleWidth
    Else
        lWidth = Me.ScaleHeight
    End If
    
    Set m_img = Cairo.CreateSurface(500, 500, ImageSurface, App.Path & "\clock.png")
    
    Me.Cls
    Me.BackColor = vbRed
    Me.Refresh
    m_img.DrawToDC Me.hDC, 0, 0, lWidth, lWidth
    'm_img.WriteContentToPngFile "d:\weg1.png"

    Me.Refresh

End Sub

[Schmidt]

Why does the cairo surface draw a black frame?

The cCairoSurface.DrawToDC Method is using StretchDIBits under the covers -
which has no support for the AlphaChannel of a "cairo-DIB-memallocation".

And whilst the GDI-AlphaBlend-call would support Alpha-renderings directly,
it can choke in some scenarios (related to clipping and stretching)...
where StretchDIBits simply does reliable work even in these corner-cases.

What am I missing?

What you're missing, is to simply paint the (apparently "solidcolor")
FormBackground as the first operation within a given Surface-Context (via CC.Paint)...
...before blitting the result back to the Form (via DrawToDC)

FWIW, here's code which visualizes a pre-loaded img-resource on a Form:

Option Explicit

Private CC As cCairoContext

Private Sub Form_Load()
  AutoRedraw = True
  Cairo.ImageList.AddImage "clock", "c:\temp\test.png", 500, 500 'pre-load an image-resource
End Sub

Private Sub Form_Resize()
  ScaleMode = vbPixels 'ensure a Form-covering (second) "backbuffer-surface-context"
  Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
  
  CC.Paint 1, Cairo.CreateSolidPatternLng(Me.BackColor) 'paint this backbuffer-context in the same color as the form
  CC.RenderSurfaceContent "clock", 0, 0, ScaleWidth, ScaleHeight, , , True 'and render the preloaded image "scaled" with "KeepAspectRatio"=true
  
  CC.Surface.DrawToDC hDC 'now, simply blit the whole backbuf to the FOrm (unstretched, because the image-res is already sitting stretched on it)
  If AutoRedraw Then Refresh
End Sub

Olaf

[tmighty2]

Preparing a new background color would not do it.
I need to draw my image (in this case a clock with a shadow) over an image (let's say the form's background image) multiple times.
It would look like this:



In the past I have used only LaVolpe' c32bppdib class, and I want to try how cairo performs. To test that out, I was trying to port my current solution to cairo.

In my current approach, I use 1 c32bppidb as the background image.
At rendering, I first draw the background image on the form's DC, and then the various clocks over it.
The c32bppdib images in aspect of transparency work as I expected.

At first I tried cairocontext / surface, but as I explained, the black background woud not do go awy.
I have tried the image list now, and it works like a c32bppdib:

Cairo.ImageList.AddIconFromFile "clock", "C:\Users\AngeloMerte\Desktop\timetimer\shadowclock.png"

I dont' have to copy the forms's background first.

Perhaps you misunderstood what I wanted to do?

[Schmidt]

In my current approach, I use 1 c32bppidb as the background image.
At rendering, I first draw the background image on the form's DC, and then the various clocks over it.

If you work with a "Form-covering Cairo-Surface" (as in my last example above):
- you don't build up your scene "on your Form-hDC"
- but instead in that Form-covering Cairo-Surface

E.g. when you write, that you draw a c32bppDIB (which holds that bg-image) on the Form-hDC) -
now you draw a cCairoSurface (which holds that bg-image under the Key "bg") onto the Form-Covering BackBuf-CC

Option Explicit

Private CC As cCairoContext '<-- Form-covering BackBuffer-context

Private Sub Form_Load()
  AutoRedraw = True
  Cairo.ImageList.AddImage "bg", "c:\temp\bg.jpg" 'preload a (usually non-alpha) background-image-resource
  Cairo.ImageList.AddImage "clock", "c:\temp\test.png", 500, 500 'pre-load an image-resource
End Sub

Private Sub Form_Resize()
  ScaleMode = vbPixels 'ensure a Form-covering (second) "backbuffer-surface-context"
  Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext 're-create the  Form-covering BackBuffer-Surface-Context
  
  'CC.Paint 1, Cairo.CreateSolidPatternLng(Me.BackColor) 'clearance via a solid color not needed anymore
  CC.RenderSurfaceContent "bg", 0, 0, CC.Surface.Width, CC.Surface.Height 'instead we now use a stretched bg-image to "clear the scene"
  
  CC.RenderSurfaceContent "clock", 0, 0
  CC.RenderSurfaceContent "clock", 600, 300
  
  CC.Surface.DrawToDC hDC 'now, simply blit (copy) the whole backbuf to the Form  
  If AutoRedraw Then Refresh
End Sub

In case it is not clear from the example...
The Cairo.ImageList offers all kind of versatile "Img-Resource-Loading-functions" - and it is usually engaged at App-Startup.
(after that, all your image- and icon- resources sit in that central-place under a given String-Key).

You can now "make use of these resources" via the String-Key you gave at "ImageList-Load-Time" -
via CC.RenderSurfaceContent <SomeSurfaceObject_Or_ImageListStringKey>, ...
(and put them "stretched or non-stretched" onto any Cairo(Sub)Surface you want).



Olaf

[tmighty2]

How would I create an image in the imagelist without a physical file?

I wanted to create an image (cCairoSurface) in the imagelist onto which I could render the blue remaining minutes (cake), but this line would throw "Path not found":

Set CC = Cairo.ImageList.AddImage("remainingminutesascake", "", 256, 256).CreateContext

Just in case you are asking why I want to use an imagelist image: I can't get rid of the black background that occurs when rendering something that is not in an imagelist.

Attachment 187925

Option Explicit

Private CC As cCairoContext ' the drawing-context (derived from a Cairo-Surface)

Private Const m_MinutesDiameterAt256x256px As Long = 151 ' Global variable to store the size of the analog clock

Private Sub pDrawRemainingMinutes(ByVal uBitmapToDrawOnto As Long, ByVal uMinutesRemaining As Long, ByVal uClockLeft As Long, ByVal uClockTop As Long, ByVal uClockSizeAtCurrentImageSize As Long)
    On Error GoTo errhandler

    Dim uHowMuchPercentIsCircleClosed As Long

    Dim bRecreate As Boolean
    bRecreate = False

    If CC Is Nothing Then
        bRecreate = True
    Else
        bRecreate = (CC.Surface.Width <> uClockSizeAtCurrentImageSize) Or (CC.Surface.Height <> uClockSizeAtCurrentImageSize)
    End If

    If bRecreate Then
         Set CC = Cairo.ImageList.AddImage("remainingminutesascake", "", 256, 256).CreateContext
    End If

    CC.Operator = CAIRO_OPERATOR_CLEAR
    CC.Paint
    CC.Operator = CAIRO_OPERATOR_OVER 'reset to the default-operator

    Dim centerX As Long
    Dim centerY As Long
    centerX = uClockSizeAtCurrentImageSize \ 2
    centerY = uClockSizeAtCurrentImageSize \ 2

    DrawCenteredCake CC, uClockSizeAtCurrentImageSize / 2, uHowMuchPercentIsCircleClosed, uMinutesRemaining, vbBlue, centerX, centerY

    CC.Surface.DrawToDC uBitmapToDrawOnto, uClockLeft, uClockTop
 
    CC.Save

Exit Sub
errhandler:
    Debug.Print Err.Description
    Debug.Assert False
    'Call modLog.CriticalLog("#clsButton_pDrawHotValue: " & Err.Description & ", err.number: " & Err.Number & ", Params: '" & "" & "'")
End Sub

[tmighty2]

Is it possible to test the behaviour without using a "Form-covering Cairo-Surface"?
I am used to reacting to the WM_PAINT even to see what in my surface needs to be redrawn.
I guess you will now say "Sure, that's the PAINT event".
And I even just found it:

Event Paint(CC As cCairoContext, dx As Double, dy As Double)
Mitglied von RC6.cwCanvas

Ok, so there there seems to be nothing from stopping me from using cairo. Thank you so much!
I will only to have stick with c32bppdib for a while because I can't switch so quickly from just blitting onto a surface to first getting the surface and then painting on it.
I guess that was the reason why you wrote that converter function for me that allowed me to keep using it.

[tmighty2]

Deleted to due to copyright.

[Arnoutdv]

It's not just skewing an image but projecting a side of a 3D object to a 2D canvas.

Like drawing a 3D cube on a canvas, but then painting only a single side
In your case the cube is also rotated on at least 2 axes.

https://bpb-us-w2.wpmucdn.com/sites....3dto2dproj.pdf

[tmighty2]

Yes, please!
:-)