VB6 Cairo-Paths and Projections

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"):
Attachment 186034

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"):
Attachment 186035

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

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

Code:

---

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

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

Quote:

---

Originally Posted by 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?

---

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

Code:

---

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

---

Attachment 186056

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

Attachment 187500
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:

Code:

---

      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?

Quote:

---

Originally Posted by tmighty2

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):

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:
Attachment 187507

HTH

Olaf

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.

Code:

---

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!

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

---

----

Quote:

---

Originally Posted by 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.

Code:

---

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

---

---

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

Code:

---

  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

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:

Code:

---

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

---

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

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

Attachment 187517

Attachment 187518

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

Quote:

---

Originally Posted by tmighty2

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:

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

Attachment 187519

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.

This works flawlessly. Thank you!

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

Quote:

---

Originally Posted by tmighty2

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").

Code:

---

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

Wonderful!! Thank you. It looks so good!

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.

Code:

---

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

---

Quote:

---

Originally Posted by tmighty2

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

---

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

Olaf

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.

Quote:

---

Originally Posted by 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.

---

Code:

---

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

This is amazing!
Thank you!!

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?

Attachment 187603

Code:

---

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

---

Ah, I got it:

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

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

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.

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

Code:

---

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

---

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?

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

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")

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

Code:

---

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

---

Quote:

---

Originally Posted by tmighty2

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.

Quote:

---

Originally Posted by tmighty2

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:

Code:

---

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

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:

Attachment 187919

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?

Quote:

---

Originally Posted by tmighty2

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

Code:

---

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

Attachment 187920

Olaf

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

Code:

---

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

---

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.

Deleted to due to copyright.

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

Yes, please!
:-)

I'm sorry, but I'm not going to write the code for you.

Maybe this thread can be of any help to you:
https://www.vbforums.com/showthread....on-of-an-image

I experience something strange: Instead of transforming the image, the image slowly changes its color. It looks like a color animation.
Does anybody see what I'm doing wrong in "pRotate"?

Code:

---

Option Explicit

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



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

Private Sub Form_Load()
    Set m_img = New c32bpp.c32bppDIB
    m_img.LoadPicture_File App.Path & "\clock.png"
End Sub

Private Sub Form_Resize()
    Me.Cls
   
    Dim lWidth As Long
    Dim lHeight As Long
   
    If Me.ScaleWidth < Me.ScaleHeight Then
        lWidth = Me.ScaleWidth
        lHeight = Me.ScaleWidth ' Use the width as the height to create a square image
    Else
        lWidth = Me.ScaleHeight
        lHeight = Me.ScaleHeight ' Use the height as the width to create a square image
    End If
   
    Dim lLeft As Long
    Dim lTop As Long
    Dim lRight As Long
    Dim lBottom As Long
   
    ' Center the image
    lLeft = (Me.ScaleWidth - lWidth) \ 2
    lTop = (Me.ScaleHeight - lHeight) \ 2
    lRight = lLeft + lWidth
    lBottom = lTop + lHeight
   
    m_img.Render Me.hDC, lLeft, lTop, lWidth, lHeight
   
    Dim uClockSize& ' Global variable to store the size of the analog clock
    ' Calculate the size and position of the analog clock
    uClockSize = lRight - lLeft ' Size of the clock (diameter)
    Dim uClockLeft As Long
    uClockLeft = lLeft + (lWidth - uClockSize) \ 2
    Dim uClockTop As Long
    uClockTop = lTop + (lHeight - uClockSize) \ 2
   
    Dim lMinutesRemaining As Long
    lMinutesRemaining = 45
   
    ' Calculate the diameter of the clock based on the current image size
    Dim referenceImageSize As Long
    referenceImageSize = 256 ' Reference image size where the clock size is 80

    Dim lDiameterOfRemainingMinutesAtReferenzImageSize256px As Long
    lDiameterOfRemainingMinutesAtReferenzImageSize256px = 151 'pixels
   
    ' Calculate the size and position of the analog clock
    Dim clockSizeAtCurrentImageSize As Long
    clockSizeAtCurrentImageSize = (lRight - lLeft) * lDiameterOfRemainingMinutesAtReferenzImageSize256px / referenceImageSize  ' Calculate the proportional size of the clock

    Dim uHowMuchPercentIsCircleClosed As Long
    Dim bRecreate As Boolean
    bRecreate = False

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

    If bRecreate Then
        Set CC = Cairo.CreateSurface(uClockSize, uClockSize).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 = uClockSize \ 2
    centerY = uClockSize \ 2


    CC.Save 'store the current state (since we use a coordsystem-shift and a rotation below)
    CC.TranslateDrawings centerX, centerY 'the new coord(0,0) is now at the center
    CC.RotateDrawingsDeg -90 'to let the angle start at the top

    Dim startAngleRad As Double
    Dim endAngleRad As Double
   
    ' Calculate the start angle based on the remaining minutes
    startAngleRad = 180 * (Cairo.PI / 180)
    ' startAngleRad = BerechneGradzahl(lMinutesRemaining) * (Cairo.PI / 180)
    startAngleRad = ((60 - lMinutesRemaining) / 60) * 360 * (Cairo.PI / 180)
    endAngleRad = 360 * (Cairo.PI / 180) ' The end angle is fixed at 270 degrees

    CC.MoveTo 0, 0
    CC.Arc 0, 0, uHowMuchPercentIsCircleClosed, startAngleRad, endAngleRad

    CC.LineTo 0, 0 ' Connect the arc to the center
    CC.ClosePath

    CC.Fill , Cairo.CreateSolidPatternLng(Color, 0.9) ' Fill the cake slice with 40% alpha
   
    pRotate CC

    CC.Restore


    Dim DIB32 As c32bppDIB
    Set DIB32 = CreateDIB32FromSurface(CC.Surface)
    DIB32.Render Me.hDC, uClockLeft, uClockTop

    CC.Save
   
    Me.Refresh

End Sub

Private Sub pRotate(ByRef context As cCairoContext)
    '# Save the initial context state
    context.Save

    Dim lWidth As Long
    Dim lHeight As Long
    lWidth = context.Surface.Width
    lHeight = context.Surface.Height

    '# Apply the 2D transformation
    context.TranslateDrawings lWidth / 2, lHeight / 2  '# Translate to the center
    context.ScaleDrawings 0.8, 1  ' # Scale the image (width: 80%, height: 100%)
    context.RotateDrawingsDeg 5  '# Rotate the image by an angle in degrees

    '# Draw the transformed image
    context.Operator = CAIRO_OPERATOR_SOURCE ' Set the operator to SOURCE to overwrite the existing content
    context.Paint

    '# Restore the initial context state
    context.Restore

End Sub

---

Quote:

---

Originally Posted by tmighty2

Code:

---

    '# Apply the 2D transformation
    context.TranslateDrawings lWidth / 2, lHeight / 2  '# Translate to the center
    context.ScaleDrawings 0.8, 1  ' # Scale the image (width: 80%, height: 100%)
    context.RotateDrawingsDeg 5  '# Rotate the image by an angle in degrees

---

---

Yep, such a transform-triple can be used, to "fit" a normal circle (arc) onto a perspective-wise "3D-ish" Base-Image.

Here is a Demo-ZIP:
Attachment 188016

And here a ScreenShot:
Attachment 188015

Olaf

This is really beautiful, thank you.

I am drawing a cairo surface (a png with transparency) onto a c32bppdib.

First I draw the button (seen in blue with an orange) orange using gdi+.
All looks fine. Then I draw the alpha png onto it, and it seems to overwrite what is currently here:

Attachment 188317

What am I missing?

Edit: Ok, I guess I have to use the helper class again:

Code:

---

    Dim lThis&
    lThis = CairoImageListIndexByKey(sGUID)
   
    If lThis > -1 Then
      ' Cairo.ImageList.ItemByIndex(lThis).DrawToDC destinationDC, destX, destY, destWidth, destHeight
       
        Dim cc As cCairoSurface
        Set cc = Cairo.ImageList.ItemByIndex(lThis)
       
        Dim DIB32 As c32bppDIB
        Set DIB32 = CreateDIB32FromSurface(cc.CreateContext.Surface)
        DIB32.Render destinationDC, destX, destY
       
    Else
        Debug.Assert False
    End If

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
      rc6.New_c.MemCopy pDst, pSrc, Srf.stride
        pSrc = pSrc - Srf.stride: pDst = pDst + Srf.stride
    Loop Until pSrc < Srf.DataPtr
End Function

---

Using an image list which is not limited in size is amazing. I mean that it allows any size (like 420x860 or 256x256).


Is there any reason why something like c32bpp dib is not in RC6?

I noticed that Olaf didn't say "You can just use this and this in RC6", but instead he wrote me a helper function so that I could keep using c32bppdib.

Quote:

---

Originally Posted by tmighty2

Is there any reason why something like c32bpp dib is not in RC6?

---

Because everything it offers (and much more) can be accomplished with a cCairoSurface. ;)

Quote:

---

Originally Posted by tmighty2

I noticed that Olaf didn't say "You can just use this and this in RC6", but instead he wrote me a helper function so that I could keep using c32bppdib.

---

I wrote this helper-function for you, to allow you an easier "migration" ...
(for the hopefully short phase, where you use both of the classes in parallel in your project).

Your button-example above is "incomplete code" (I cannot run it here via simple Copy&Paste) -
otherwise I'd have shown you how to do it with "only a cCairoSurface" (like in the many examples before, here in this thread).

Olaf

FWIW - to make integration of a "Form-backing cCairoSurface" easier for "dozens of Forms"...

Below is a generic Class, which can be integrated with few lines of code into any Form
(to support Cairo-CC-based Drawings):

cCairoBackBuf.cls

Code:

---

Option Explicit

Event Paint(CC As cCairoContext)
 
Private WithEvents Form As Form, BBuf As cCairoSurface, BGPat As cCairoPattern

Public Sub BindTo(VBForm As Form, Optional BGPattern As cCairoPattern)
  Set Form = VBForm
      Form.AutoRedraw = False '<- save resources... (we don't need VBs own BackBuffering, since we provide our own BackBuffer here)
  If BGPattern Is Nothing Then
    Set BGPat = Cairo.CreateSolidPatternLng(Form.BackColor) 'use a plain, solid (Form.Background)-Color as the BGPattern
  Else
    Set BGPat = BGPattern 'use the optionally provided pattern (e.g. the one from Cairo.CreateCheckerPattern)
  End If
  Form_Resize
End Sub

Public Sub Refresh()
  Dim CC As cCairoContext
  Set CC = BBuf.CreateContext
      CC.Paint 1, BGPat 'clear the current BackGround with this Pattern (on the entire BBuf-area)
  RaiseEvent Paint(CC)  'raise a CC-based BBuf_Paint event to the outside (into the hosting Form)
  BBuf.DrawToDC Form.hDC
End Sub

Private Sub Form_Resize()
  Dim W: W = Form.ScaleX(Form.ScaleWidth, Form.ScaleMode, vbPixels)
  Dim H: H = Form.ScaleX(Form.ScaleHeight, Form.ScaleMode, vbPixels)
  Set BBuf = Cairo.CreateSurface(W, H)
  Refresh
End Sub

Private Sub Form_Paint() 'Form_Paint will only reflect the current content of the BBuf (and not refresh the entire scene)
  BBuf.DrawToDC Form.hDC
End Sub

---

The integration-efforts are now much easier, here's a "minimal-example":

Code:

---

Option Explicit

Private WithEvents BBuf As cCairoBackBuf

Private Sub Form_Load()
  Set BBuf = New cCairoBackBuf: BBuf.BindTo Me ', Cairo.CreateCheckerPattern
End Sub

Private Sub BBuf_Paint(CC As RC6.cCairoContext) 'do all your CC-based Form-drawings here...
  CC.TextOut 20, 20, "Hello World" 'produce some CC-based output on the Form
End Sub

---

A slightly larger example shows, hot to render "directly from an ImageList-Key":
(without prior conversion of those ImgList-Keys to indexes, because it's just not needed)

Code:

---

Option Explicit

Private WithEvents BBuf As cCairoBackBuf

Private Sub Form_Load()
  Cairo.ImageList.AddIconFromResourceFile "GUID1", "shell32", 167 'add two res-images into the ImgList
  Cairo.ImageList.AddIconFromResourceFile "GUID2", "shell32", 169
 
  Set BBuf = New cCairoBackBuf: BBuf.BindTo Me, Cairo.CreateCheckerPattern 'ensure the binding (this time with a checker-pattern-bg)
End Sub

Private Sub BBuf_Paint(CC As RC6.cCairoContext)
  If Cairo.ImageList.Exists("GUID1") Then CC.RenderSurfaceContent "GUID1", 20, 20
  If Cairo.ImageList.Exists("GUID2") Then CC.RenderSurfaceContent "GUID2", 100, 100
End Sub

---

Result of the last Form-example:
Attachment 188321

HTH

Olaf

----

-----

I would like to ask for advice how to render such an effect:

https://www.youtube.com/watch?v=4kksKUdNBO8

The closest I could find was the "perspective" sample:

Attachment 189764

But I didn't find a way to flip only an edge.