VB6 Cairo-Paths and Projections

[Arnoutdv]

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

[tmighty2]

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

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

[Schmidt]

    '# 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:
HollowCircleTimer.zip

And here a ScreenShot:


Olaf

[tmighty2]

This is really beautiful, thank you.

[tmighty2]

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:



What am I missing?

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

    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.

[Schmidt]

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.

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

[Schmidt]

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

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

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)

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:


HTH

Olaf

[tmighty2]

----

[tmighty2]

-----

[tmighty2]

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:



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