VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cShapeRoundRect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private WithEvents TopLeft As cControlPoint
Attribute TopLeft.VB_VarHelpID = -1
Private WithEvents BottomDown As cControlPoint
Attribute BottomDown.VB_VarHelpID = -1
Private WithEvents CenterDrag As cControlPoint
Attribute CenterDrag.VB_VarHelpID = -1
Private WithEvents LinearGradientStart As cControlPoint
Attribute LinearGradientStart.VB_VarHelpID = -1
Private WithEvents LinearGradientEnd As cControlPoint
Attribute LinearGradientEnd.VB_VarHelpID = -1

Public Sub Init(Controlpoints As cControlPoints, ByVal X As Double, ByVal Y As Double, ByVal Width As Double, ByVal Height As Double)
  Set TopLeft = Controlpoints.Add("TopLeft" & ObjPtr(Me), X, Y, vbGreen, 6)
  Set BottomDown = Controlpoints.Add("BottomDown" & ObjPtr(Me), X + Width, Y + Height, vbGreen, 6)
  Set CenterDrag = Controlpoints.Add("CenterDrag" & ObjPtr(Me), X + Width / 2, Y + Height / 2, vbMagenta, 9)
  Set LinearGradientStart = Controlpoints.Add("LinearGradientStart" & ObjPtr(Me), X + Width * 0.1, Y + Height * 0.1, vbCyan, 5)
  Set LinearGradientEnd = Controlpoints.Add("LinearGradientEnd" & ObjPtr(Me), X + Width * 0.9, Y + Height * 0.9, vbCyan, 5)
End Sub

Public Sub Draw(CC As cCairoContext)
Dim Pat As cCairoPattern
  CC.Save
    'as always, we define the path first... (in this case a simple RoundedRect is created)
    CC.RoundedRect TopLeft.X, TopLeft.Y, Width, Height, 15
    
    Set Pat = Cairo.CreateLinearPattern(LinearGradientStart.X, LinearGradientStart.Y, LinearGradientEnd.X, LinearGradientEnd.Y)
      Pat.AddColorStop 0, vbYellow, 0#
      Pat.AddColorStop 1, vbRed, 1
    CC.Fill True, Pat '<- note the Optional "True"-param before "Pat", meaning we do *not* want to close the path yet...
    
    '...since we plan to draw a Border this time too (with a different Stroke-Color)
    CC.SetSourceColor vbBlack, 0.5
    CC.Stroke '*now* the Path gets closed (no Optional DontClosePath-Param set) - and we ensure thereby a combined Fill+Stroke
  CC.Restore
End Sub

Public Property Get Width() As Double
  Width = BottomDown.X - TopLeft.X
End Property
Public Property Get Height() As Double
  Height = BottomDown.Y - TopLeft.Y
End Property


'Control-Point Movement-Events are received below, and we will act accordingly with the necessary adaptions

Private Sub TopLeft_PositionChanging(NewX As Double, NewY As Double)
  If BottomDown.X - NewX < 30 Then NewX = BottomDown.X - 30 'we restrict the Width to a minimum of 30 pixels
  If BottomDown.Y - NewY < 30 Then NewY = BottomDown.Y - 30 'and the Height too...
  
  'adjust the relative positions of the LinearGradient-ControlPoints
  AdjustLinearGradientPoints NewX + Width / 2, NewY + Height / 2, (BottomDown.X - NewX) / Width, (BottomDown.Y - NewY) / Height
  
  CenterDrag.X = NewX + Width / 2 '...and readjust the centerPoint accordingly as well
  CenterDrag.Y = NewY + Height / 2
End Sub
Private Sub BottomDown_PositionChanging(NewX As Double, NewY As Double)
  If NewX - TopLeft.X < 30 Then NewX = TopLeft.X + 30 'we restrict the Width to a minimum of 30 pixels
  If NewY - TopLeft.Y < 30 Then NewY = TopLeft.Y + 30 'and the Height too...
  
  'adjust the relative positions of the LinearGradient-ControlPoints
  AdjustLinearGradientPoints NewX - Width / 2, NewY - Height / 2, (NewX - TopLeft.X) / Width, (NewY - TopLeft.Y) / Height
  
  CenterDrag.X = NewX - Width / 2 '...and readjust the centerPoint accordingly as well
  CenterDrag.Y = NewY - Height / 2
End Sub
Private Sub CenterDrag_PositionChanging(NewX As Double, NewY As Double)
Dim W#, H#
  W = Width: H = Height 'we need to buffer the current width and height beforehand, to not mess-up the coord-adaptions below, since Width- and Height are dynamically calculated in Properties
  
  TopLeft.X = NewX - W / 2
  TopLeft.Y = NewY - H / 2
  
  BottomDown.X = NewX + W / 2
  BottomDown.Y = NewY + H / 2
  
  AdjustLinearGradientPoints NewX, NewY
End Sub

'small helper-Sub, to adjust the relative placement of the LinearGradient-ControlPoints
Private Sub AdjustLinearGradientPoints(CenterX As Double, CenterY As Double, Optional RatioX As Double = 1, Optional RatioY As Double = 1)
Dim RLdXStart#, RLdYStart#, RLdXEnd#, RLdYEnd#
  RLdXStart = LinearGradientStart.X - CenterDrag.X
  RLdYStart = LinearGradientStart.Y - CenterDrag.Y
  
  RLdXEnd = LinearGradientEnd.X - CenterDrag.X
  RLdYEnd = LinearGradientEnd.Y - CenterDrag.Y
  
  LinearGradientStart.X = CenterX + RLdXStart * RatioX
  LinearGradientStart.Y = CenterY + RLdYStart * RatioY

  LinearGradientEnd.X = CenterX + RLdXEnd * RatioX
  LinearGradientEnd.Y = CenterY + RLdYEnd * RatioY
End Sub

