VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cwSimpleButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Please look into the comments of cwHelloWorld, to get a more commented
'"for beginners" introducion, on how to implement a very simple widget.
'Then another look into the code of cwLabel (and the comments there) is recommended

'Anyways - everybody seems eager to implement his own nice Buttons nowadays ;-),
'so here is one simple example, which tries to mimick "default Vista-Style" -
'with plain cairo-VectorDrawing-commands and some gradients.

'Here we will also introduce Event-Raising to the outside, as well
'as the interaction with cCairos global ImageList (to be able to render
'an Icon within the Button per simple "StringKey-Addressing") ... *and*
'we will show Access- and Default/Cancel- KeyHandling definable as usual per
''&'-Prefix before a given Caption-Char (or by setting the W.Default or W.Cancel-Flags)

Option Explicit

Event Click() 'these 4 Events will do here for this simpler Button-Implementation
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)

Private mCaption As String 'the only "internal Property-Variable" we use here
Private BDown As Boolean, Outside As Boolean 'just two internal State-Flags
'and the Vars below are (re-)set in each Paint-Event (derived from current W-states),
'to avoid - passing them around as Parameters into each SubDrawing-Function
Private X As Double, Y As Double, DX As Double, DY As Double, AlphaInherited As Double


'****---- Start of cwImplementation-Conventions ----****
Private WithEvents W As cWidgetBase
Attribute W.VB_VarHelpID = -1

Private Sub Class_Initialize()
  Set W = New cWidgetBase '<- this is required in each cwImplementation...
 
  'Any Alpha-Value lower than 1 (which would be Default=FullOpacity), tells the Windowmanager
  'to go one level down in the redrawing-queues ZOrder - so we use 0.99 here (although this
  'Control is meant to be drawn opaque=1), because this Widget is not drawing its entire
  'rectangular Clip-Region ... we "leave the corners out" - due to the RoundedRectanlge-
  'outline we use here - and 0.99 just ensures, that our Parent.Background will be (re)drawn before us
  
  W.Alpha = 0.99 '<- define a Value "eaqual to Full Opacity" (but not 1) to draw "rounded Widgets"
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
'****---- End of cwImplementation-Conventions ----****


'only one Public Property-implementation in this simple Demo
Public Property Get Caption() As String
  Caption = mCaption
End Property
Public Property Let Caption(ByVal NewValue As String)
Dim AccKey$, Pos&
  If mCaption = NewValue Then Exit Property
  mCaption = NewValue
  W.Refresh
  Pos = InStr(Replace(mCaption, "&&", "--"), "&")
  If Pos Then AccKey = Mid$(Replace(mCaption, "&&", "--"), Pos + 1, 1)

  If Len(AccKey) Then W.AccessKeys = AccKey
End Property

'but some more W-Event-Handling is necessary here, compared with the cwLabels
'the Window-Manager (cWidgetRoot) does not perform that many W.Refreshs automatically under the hood,
'to prevent "stacked up, unnecessary Refreshs" - instead you should and can decide on your own
'(with better control) - when and in which cases you trigger such an Refresh - but this Command-Button
'here is already a pretty mature Control, with a lot of different States (focused or not, hovered or not)
'usually caused by the Mouse-Interaction- and Focus-Events, so in order to reflect thes state-changes
'also visually, we need to react appropriately and force Refreshs ourselfes in many of the Events below.
'Nonetheless, to keep the performance at a good level, don't "overdo" this Refresh-stuff too much,
'if you're not sure about, if such an Refresh at a given position really is required, just leave it
'out and test, if the internal self-triggering (also caused by other Widgets in the Redraw-Queue) already
'ensures proper state-redrawing...
Private Sub W_GotFocus()
  W.Refresh
End Sub
Private Sub W_LostFocus()
  W.Refresh
End Sub

Private Sub W_AccessKeyPress(KeyAscii As Integer)
  If (KeyAscii = vbKeyReturn And W.Default) Or (KeyAscii = vbKeyEscape And W.Cancel) Then
    If Not (DefaultStateCondition Or W.Cancel) Then Exit Sub
    W.Refresh
    RaiseEvent Click
  ElseIf InStr(1, W.AccessKeys, Chr$(KeyAscii), vbTextCompare) Then
    W.SetFocus
    RaiseEvent Click
    W.Refresh
  End If
End Sub

Private Function DefaultStateCondition() As Boolean
  If W.Root.ActiveWidget Is Nothing Then
    DefaultStateCondition = W.Default
  ElseIf Not TypeOf W.Root.ActiveWidget.Object Is cwSimpleButton Then
    DefaultStateCondition = W.Default
  End If
End Function

Private Sub W_KeyDown(KeyCode As Integer, Shift As Integer)
  RaiseEvent KeyDown(KeyCode, Shift)
  If KeyCode = 32 Then BDown = True: W.Refresh
  If KeyCode = 13 And Shift = 0 Then
    RaiseEvent Click
  End If
End Sub

Private Sub W_KeyPress(KeyAscii As Integer)
  RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub W_KeyUp(KeyCode As Integer, Shift As Integer)
  RaiseEvent KeyUp(KeyCode, Shift)
  If KeyCode = 32 Then
    RaiseEvent Click
    BDown = False: W.Refresh
  End If
End Sub

Private Sub W_MouseEnter(ByVal MouseLeaveWidget As cWidgetBase)
  W.Refresh
End Sub
Private Sub W_MouseLeave(ByVal MouseEnterWidget As cWidgetBase)
  W.Refresh
End Sub

Private Sub W_MouseDown(Button As Integer, Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Button = 1 Then BDown = True: W.Refresh
End Sub
Private Sub W_MouseMove(Button As Integer, Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Outside = (X < 0 Or X > DX Or Y < 0 Or Y > DY)
  If BDown Then W.Refresh
End Sub
Private Sub W_MouseUp(Button As Integer, Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If BDown And Not Outside Then
    RaiseEvent Click
  End If
  BDown = False: Outside = False: W.Refresh
End Sub

Private Sub W_Resize()
  DX = W.Width 'same things as for the X/Y-Value-saving in the Paint-Event below...
  DY = W.Height '...only that we adapt the class-private Vars DX/DY here in the Resize-Event
End Sub
Private Sub W_Paint(CC As dhCairo.cCairoContext, ByVal xAbs As Single, ByVal yAbs As Single, ByVal DX As Single, ByVal DY As Single, UserObj As Object)
  'other than in the two cwLabel-Implementations we store some often used Values in Module-Private-Variables, to not
  'stress the W.Methods too much - and to avoid to pass all this stuff around as Parameters in our Drawing-Routines
  X = W.AbsLeft - xAbs
  Y = W.AbsTop - yAbs
  AlphaInherited = W.AlphaInherited 'this W-Method iterates W-internally "parentwise", to give back a premultiplied, "stacked-up" Alpha-Opacity-Value
  
  Draw CC 'now we can delegate to our internal Main-Drawing-Routine
End Sub

Private Sub Draw(CC As cCairoContext)
  'some global Line-Settings on our CC
  CC.SetLineCap CAIRO_LINE_CAP_ROUND
  CC.SetLineJoin CAIRO_LINE_JOIN_ROUND
  
  'and another global CC-setting with regards to the Font-Selection ... and currently (as is below),
  'the rendering of the "Non-Enabled-State" of such a Button is only doing a change in the Font-Color
  'in our implementation here, not much more - since I'm not sure yet, if I should implement something
  'like a "gray shading" of an entire (disabled) Widget directly at the engine-level (under the hood),
  'to ease the burden, to implement such a gray-shading over-and-over-again in each widget-impl. explicitely
  If W.Enabled Then
    CC.SelectFont W.FontName, W.FontSize, W.ForeColor, W.FontBold, W.FontItalic, W.FontUnderline
  Else
    CC.SelectFont W.FontName, W.FontSize, &HA0A0A0, W.FontBold, W.FontItalic, W.FontUnderline 'plain gray (&HA0A0A0) as FontColor
  End If
  
  
  'we currently decide here only between two "Main-States", Up- and Down.
  'All the rest of the additional States (Focused, Hovered, etc.) is then handled
  'either in one of the two Sub-Functions (DrawUpState, DrawDownState) or in the
  'final two routines at the end of our Sub-procedure here.
  If Not (BDown And Not Outside) Then
    DrawUpState CC
  Else
    DrawDownState CC
  End If
  
  
  If W.Enabled Then 'the two final Sub-Routines are the same for Up- and Downstate, hence placed here
    If W.Focused Then DrawFocusRectangle CC
    
    DrawBorderStateOverlays CC
  End If
End Sub

Private Sub DrawUpState(CC As cCairoContext)

  DrawButtonFaceGradient CC, 0.5, 0, 1, _
                             0.5, 0.95, _
                             0.5, 0.9, _
                             1, 0.85
   
  DrawButtonFaceShine CC, (DY - 1) \ 2, 0, 0.3, _
                                        1, 0.2

  DrawIconAndCaption CC, mCaption, 0
  
  DrawOuterBorder CC, 0.85
End Sub


Private Sub DrawDownState(CC As cCairoContext)

  DrawButtonFaceGradient CC, 0.4, 0, 0.85, _
                                  1, 1
  
  DrawButtonFaceShine CC, DY - 2, 0, 0.03, _
                                  0.1, 0.06, _
                                  0.9, 0.2, _
                                  1, 0.4
                                  
  DrawIconAndCaption CC, mCaption, 1
  
  DrawOuterBorder CC, 0.75
End Sub


'****** and here come all the small Helper-Subs, which in the future belong more into
'****** an (overridable) cTheme-Class (covering for example "Vista-Style" as their Default) -
'****** and that for more Base-routines than those, needed by relative simple Buttons.
'****** But cTheme is not finished yet - so this will be the next important thing on
'****** my priority-list, which needs to be implemented soon, before "official"
'****** Widget-Development can start in the community, please be patient
'****** a bit more - and try to learn at least the basic-behaviour of this
'****** Widget-engine, which will not change that much with regards to "coding against"...
Private Sub DrawButtonFaceGradient(CC As cCairoContext, ByVal WhiteStrokeAlpha As Double, ParamArray StopsAndShade())
Dim i&
  CC.SetLineWidth 2
  
  CC.RoundedRect X, Y, DX, DY, 3.25, True
  With Cairo.CreateLinearPattern(X, Y, Y, DY)

    For i = 0 To UBound(StopsAndShade) Step 2 'on the even indices are the Stop-Values - and on the uneven ones the Shade-Values
      .AddColorStop StopsAndShade(i), W.BackColor, AlphaInherited, StopsAndShade(i + 1)
    Next i
    
    CC.Fill True, .This

    CC.SetSourceColor vbWhite, WhiteStrokeAlpha * AlphaInherited
    CC.Stroke
  End With
End Sub

Private Sub DrawButtonFaceShine(CC As cCairoContext, ByVal Height As Double, ParamArray StopsAndAlpha())
Dim i&
  CC.RoundedRect X + 1, Y + 1, DX - 2, Height, 2, True
  With Cairo.CreateLinearPattern(X, Y + 1, X, Height)
    
    For i = 0 To UBound(StopsAndAlpha) Step 2 'on the even indices are the Stop-Values - and on the uneven ones the Alpha-Values
      .AddColorStop StopsAndAlpha(i), vbWhite, StopsAndAlpha(i + 1) * AlphaInherited
    Next i
    
    CC.Fill , .This
  End With
End Sub

Private Sub DrawIconAndCaption(CC As cCairoContext, S As String, Optional ByVal PxlOffs As Long)
  If Len(W.ImageKey) Then 'render the Image (currently only left-aligned) first, then the Caption-text with an offset
    
    CC.RenderSurfaceContent W.ImageKey, PxlOffs + 4 + (DY - W.ImageSize) / 2, PxlOffs + (DY - W.ImageSize) / 2, W.ImageSize, W.ImageSize

    CC.DrawText PxlOffs + X + 8 + W.ImageSize, PxlOffs + Y, DX - 8 - W.ImageSize, DY, S, False, vbCenter, 1, True, dtHasAccelerators
  
  Else 'draw only our text, centered over the full WidgetArea
    CC.DrawText PxlOffs + X, PxlOffs + Y, DX, DY, S, False, vbCenter, 1, True, dtHasAccelerators
  End If
End Sub

Private Sub DrawOuterBorder(CC As cCairoContext, ByVal BorderAlpha As Double)
  CC.SetLineWidth 1
  CC.RoundedRect X, Y, DX, DY, 3.25, True
  CC.SetSourceColor W.BorderColor, BorderAlpha * AlphaInherited
  CC.Stroke
End Sub

Private Sub DrawFocusRectangle(CC As cCairoContext)
Dim XOffs&
  If Len(W.ImageKey) Then XOffs = 8 + W.ImageSize
 
  CC.Save
    CC.SetLineWidth 1
    
    CC.RoundedRect X + 2 + XOffs, Y + 2, DX - 4 - XOffs, DY - 4, 2.25, True
    CC.SetDashes 0, 0.5, 1.5
    CC.SetSourceColor vbBlack, AlphaInherited * 0.6
    CC.Stroke
    
    CC.RoundedRect X + 2 + XOffs, Y + 2, DX - 4 - XOffs, DY - 4, 2.25, True
    CC.SetSourceColor vbWhite, AlphaInherited * 0.6
    CC.SetDashes 0.75, 0.5, 1.5
    CC.Stroke
  CC.Restore
End Sub

Private Sub DrawBorderStateOverlays(CC As cCairoContext)
Dim BorderOverlayColor As Long
  BorderOverlayColor = IIf(W.MouseOver, W.HoverColor, W.FocusColor)
  
  If W.MouseOver Or W.Focused Or DefaultStateCondition Then
    If Not (BDown And Not Outside) Then CC.SetLineWidth 2.5
    CC.RoundedRect X, Y, DX, DY, 3.25, True

    CC.SetSourceColor BorderOverlayColor, AlphaInherited * 0.5
    CC.Stroke
  End If
End Sub


