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
Printable View
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
Yep, such a transform-triple can be used, to "fit" a normal circle (arc) onto a perspective-wise "3D-ish" Base-Image.Quote:
Originally Posted by tmighty2
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:
Using an image list which is not limited in size is amazing. I mean that it allows any size (like 420x860 or 256x256).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
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.
Because everything it offers (and much more) can be accomplished with a cCairoSurface. ;)Quote:
Originally Posted by tmighty2
I wrote this helper-function for you, to allow you an easier "migration" ...Quote:
Originally Posted by tmighty2
(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
The integration-efforts are now much easier, here's a "minimal-example":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
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)
Result of the last Form-example: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
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.