The Demo-Source needs a reference to the free vbRichClient5-lib, which is located and available on:
http://www.vbRichClient.com/#/en/Downloads.htm
It's currently only the drawing which is solved - so this Control-Class has no Extra-features yet (as e.g. settable Alarm-Times or other "bells and whistles")
But the drawing is done nicely as I think - and the amount of code needed is still pretty small.
Here's the Class-Code (cwClock.cls)
And here the Form-Code (fTest.frm)
Attached is the usual ScreenShot and a Zip-File which contains the above Code again (together with a set of Image-ResourceFiles the small Example is based on).
http://www.vbRichClient.com/#/en/Downloads.htm
It's currently only the drawing which is solved - so this Control-Class has no Extra-features yet (as e.g. settable Alarm-Times or other "bells and whistles")
But the drawing is done nicely as I think - and the amount of code needed is still pretty small.
Here's the Class-Code (cwClock.cls)
Code:
Option Explicit
Private WithEvents W As cWidgetBase, WithEvents tmrTick As cTimer
Private ClockSrf As cCairoSurface
Private PatHour As cCairoPattern, PatMinute As cCairoPattern, PatSecond As cCairoPattern
Private Sub Class_Initialize()
Set W = Cairo.WidgetBase '<- this is required in each cwImplementation...
W.Moveable = True
Set tmrTick = New_c.Timer(490, True)
End Sub
Public Property Get Widget() As cWidgetBase
Set Widget = W
End Property
Public Property Get Widgets() As cWidgets
Set Widgets = W.Widgets
End Property
Private Sub tmrTick_Timer()
W.Refresh
End Sub
Private Sub W_Paint(CC As vbRichClient5.cCairoContext, ByVal xAbs As Single, ByVal yAbs As Single, ByVal dx_Aligned As Single, ByVal dy_Aligned As Single, UserObj As Object)
Dim CCclk As cCairoContext, D As Date
If Not Cairo.ImageList.Exists(W.ImageKey) Then Exit Sub
W.ToolTip = W.Key & vbCrLf & "You can drag me around..."
If ClockSrf Is Nothing Then InitClockSurfaceAndClockHandPatterns
Set CCclk = ClockSrf.CreateContext
CCclk.Operator = CAIRO_OPERATOR_SOURCE
CCclk.RenderSurfaceContent W.ImageKey, 0, 0 'clear the last contents with a fresh copy from the Imagelist-Key
CCclk.Operator = CAIRO_OPERATOR_OVER
CCclk.TranslateDrawings ClockSrf.Width / 2, ClockSrf.Height / 2 'shift the coord-system from the TopLeft-Default to the center
D = Now()
DrawPat CCclk, PatHour, ((Hour(D) Mod 12) + Minute(D) / 60) * 5 * 6, 1.5
DrawPat CCclk, PatMinute, (Minute(D) + Second(D) / 60) * 6, 2.75
DrawPat CCclk, PatSecond, Second(D) * 6, 3.75
With Cairo.CreateRadialPattern(0, 0, 7, 2.2, -2.2, 0)
.AddGaussianStops_TwoColors &HAA, vbWhite, , 0.6
CCclk.ARC 0, 0, 7
CCclk.Fill , .This
End With
CC.RenderSurfaceContent ClockSrf, 0, 0, dx_Aligned, dy_Aligned, , W.Alpha
End Sub
Private Sub InitClockSurfaceAndClockHandPatterns()
Set ClockSrf = Cairo.ImageList(W.ImageKey).CreateSimilar(CAIRO_CONTENT_COLOR_ALPHA)
Set PatHour = Cairo.CreateSurfacePattern(Cairo.CreateSurface(15, ClockSrf.Height))
DrawLineHands PatHour.Surface.CreateContext, ClockSrf.Height, vbBlack, 9, 0.066, 0.22
Set PatMinute = Cairo.CreateSurfacePattern(Cairo.CreateSurface(15, ClockSrf.Height))
DrawLineHands PatMinute.Surface.CreateContext, ClockSrf.Height, vbBlack, 6, 0.1, 0.29
Set PatSecond = Cairo.CreateSurfacePattern(Cairo.CreateSurface(15, ClockSrf.Height))
DrawLineHands PatSecond.Surface.CreateContext, ClockSrf.Height, &HAA, 2, 0.044, 0.34
DrawLineHands PatSecond.Surface.CreateContext, ClockSrf.Height, &HAA, 4, 0.044, -0.17
End Sub
Private Sub DrawLineHands(CC As cCairoContext, SrfHeight, Color, LineWidth, DownFac, TopFac)
CC.TranslateDrawings CC.Surface.Width / 2, SrfHeight / 2
CC.DrawLine 0, SrfHeight * DownFac, 0, -SrfHeight * TopFac, , LineWidth + 2, Color, W.Alpha * 0.33 'a thin outer-border with more alpha
CC.DrawLine 0, SrfHeight * DownFac, 0, -SrfHeight * TopFac, , LineWidth, Color, W.Alpha
End Sub
Private Sub DrawPat(CC As cCairoContext, Pat As cCairoPattern, ByVal Deg As Double, Optional ByVal ShadowOffs As Single)
Dim M As cCairoMatrix
Set M = Cairo.CreateIdentityMatrix
M.TranslateCoords Pat.Surface.Width / 2, Pat.Surface.Height / 2
M.RotateCoordsDeg -Deg
Set Pat.Matrix = M 'we do not rotate the Coord-System of the CC, but instead we rotate that of the pattern
If ShadowOffs Then
CC.Save
CC.TranslateDrawings -ShadowOffs, ShadowOffs
CC.Paint W.Alpha * 0.25, Pat
CC.Restore
End If
CC.Paint W.Alpha, Pat 'so what we do in this line, is only "a Blit" (using the already rotated Pattern-Matrix)
End SubCode:
Option Explicit
Private WithEvents Panel As cWidgetForm 'a cWidgetForm-based Panel-area (followed by 4 clock-Widget-Vars)
Private LaCrosse As cWidgetBase, Flower As cWidgetBase, Square As cWidgetBase, System As cWidgetBase
Private Sub Form_Load()
ScaleMode = vbPixels
Caption = "Resize Me... (the four Clock-Widgets are individually moveable too)"
LoadImgResources
Set Panel = Cairo.WidgetForms.CreateChild(Me.hWnd)
Panel.WidgetRoot.ImageKey = "BackGround"
Set LaCrosse = Panel.Widgets.Add(New cwClock, "LaCrosse", 0.015 * ScaleWidth, 0.16 * ScaleHeight, 501, 501).Widget
LaCrosse.ImageKey = "ClockLaCrosse" 'same as with the Background of the Panel above - just specify an ImageKey
Set Flower = Panel.Widgets.Add(New cwClock, "Flower", 0.73 * ScaleWidth, 0.01 * ScaleHeight, 501, 501).Widget
Flower.ImageKey = "ClockFlower" 'same as with the Background of the Panel above - just specify an ImageKey
Set Square = Panel.Widgets.Add(New cwClock, "Square", 0.528 * ScaleWidth, 0.65 * ScaleHeight, 501, 501).Widget
Square.ImageKey = "ClockSquare" 'same as with the Background of the Panel above - just specify an ImageKey
Set System = Panel.Widgets.Add(New cwClock, "System", 0.3405 * ScaleWidth, 0.726 * ScaleHeight, 501, 501).Widget
System.ImageKey = "ClockSystem" 'same as with the Background of the Panel above - just specify an ImageKey
System.Alpha = 0.75 '<- just to show, that this would work too of course
Move Left, Top, Screen.Width / 2, Screen.Width / 2 * 0.66
End Sub
Private Sub Panel_BubblingEvent(Sender As Object, EventName As String, P1 As Variant, P2 As Variant, P3 As Variant, P4 As Variant, P5 As Variant, P6 As Variant, P7 As Variant)
If TypeOf Sender Is cwClock And EventName = "W_Moving" Or EventName = "W_AddedToHierarchy" Then
Sender.Widget.Tag = Array(Sender.Widget.Left / ScaleWidth, Sender.Widget.Top / ScaleHeight) 'the Widgets Tag-Prop is a Variant - and can store anything
End If
End Sub
Private Sub Form_Resize()
Panel.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub Panel_ResizeWithDimensions(ByVal NewWidth As Long, ByVal NewHeight As Long)
'that doesn't really have anything to do with the analog-clock-widgets, it's just normal "percentual positioning-tricks"
LaCrosse.Move LaCrosse.Tag(0) * NewWidth, LaCrosse.Tag(1) * NewHeight, NewWidth * 0.25, NewHeight * 0.4
Flower.Move Flower.Tag(0) * NewWidth, Flower.Tag(1) * NewHeight, NewWidth * 0.16, NewHeight * 0.25
Square.Move Square.Tag(0) * NewWidth, Square.Tag(1) * NewHeight, NewWidth * 0.18, NewHeight * 0.29
System.Move System.Tag(0) * NewWidth, System.Tag(1) * NewHeight, NewWidth * 0.032, NewHeight * 0.058
End Sub
Private Sub LoadImgResources() 'just plain image-loading from disk (into the global ImageList, from where it is accessible by Key)
Cairo.ImageList.AddImage "BackGround", App.Path & "\BackGround.jpg"
Cairo.ImageList.AddImage "ClockLaCrosse", App.Path & "\ClockLaCrosse.png"
Cairo.ImageList.AddImage "ClockFlower", App.Path & "\ClockFlower.png", 251, 251
Cairo.ImageList.AddImage "ClockSquare", App.Path & "\ClockSquare.png", 401, 401
Cairo.ImageList.AddImage "ClockSystem", App.Path & "\ClockSystem.png", 401, 401
End Sub
Private Sub Form_Terminate()
If Forms.Count = 0 Then New_c.CleanupRichClientDll
End Sub