### First Shapes

#### Recap

We've read our data, and set up the parameters. The data structures are working according to our debug reports, and we have dipped our toe into recursion. Now to pull it all together and create some shapes. Since we have parent/child relationships, the idea here is that the parent shape will be big enough to accommodate all its children, grandchildren and so on. This is where recursion will be needed, to predict the height a shape is going to be.

#### What does it look like

Well- not too good. But notice that all the shapes including the frame are the right height. The starting points and widths we still need to work on - but that will be the subject of the next section. Lets look at how recursion has helped to calculate the heights of each shape, and the processing order ' me, then my children'  has ensured that the zOrder (what goes on top), is correct.

There it is. Needs a bit of work, but most of the tricky stuff is done. Lets start by looking at the height recursion

#### Calculating the height of each shape

To make this simpler, i have defined some properties that are calculated for each shape, using parameters taken from the parameter sheet as a base. These are combined using options from the parameter sheet to decide the height of any given shape.

The code for these properties is as follows - the properties paramXXXX that are referenced are taken from the parameter sheet, the full code will be at the end of this section as usual. The interesting ones from a recursion perspective are
• myExpansion - calls the recursive function biggestBranch(), whose purpose is to work down the layers of children from here to see the largest number of children any of my chidren have. The reason is that we have provided an option to suppress expansion of a parent if there is only one child. But this can only apply if none of the children have more than one child.
• mySpace- calls itself until the chain of children is completed. This is because mySpace for any item is in fact the space needed for all its children and all its childrens' children and so on. Since the frame is treated as shape, the same way as all the others, mySpace for the frame is calculated to be the space needed for all the shapes, their children and so on.
This is a tricky concept, so read the code over and make sure you get it.

`' this is the gap after me`
`Public Property Get MyGapAfterMe() As Single`
`    MyGapAfterMe = paramGap`
`End Property`
`' the gap to leave before i plot my children if i have any`
`Public Property Get MyGapBeforeChildren() As Single`
`    If pChildren.Count > 0 Then`
`        MyGapBeforeChildren = paramGap`
`    Else`
`        MyGapBeforeChildren = 0`
`    End If`
`End Property`
`' how much to allow myself to expand`
`Public Property Get MyExpansion() As Boolean`
`    MyExpansion = paramExpansion`
`    If Not paramExpansion Then`
`        MyExpansion = biggestBranch() > 1`
`    End If`
`End Property`
`Public Property Get MySpace() As Single`
`    Dim sc As cShapeContainer`
`    Dim ht As Single`
`    If pChildren.Count = 0 Then`
`        ht = paramHeight + MyGapAfterMe`
`    Else`

`        If MyExpansion Then`
`            ht = ht + MyGapBeforeChildren`
`            For Each sc In pChildren`
`                ht = ht + sc.MySpace`
`            Next sc`
`            ht = ht + MyGapAfterMe()`
`        Else`
`           ht = paramHeight + MyGapAfterMe()`
`        End If`

`    End If`
`    MySpace = ht`
`End Property`
`Public Property Get MyShapeHeight() As Single`
`    MyShapeHeight = MySpace - MyGapAfterMe`
`End Property`

#### Making the shapes

Once we have the ability to figure out the height of any given shape, all thats left now (aside from scaling and formatting) is deciding where to plot them. Again we have to do this recursively because we have to plot all our children, childrens' children etc, before we can move on to the next shape and know where to start plotting it.

Here is the code below. Notice that we create our own shape of myShapeHeight  - which itself calls the recursive mySpace to figure out the space needed for the parent, then we call our selves for each of the children.

`' this is the most complex part - creating the shapes of the correct size and placing them in the right spot`
`Public Sub makeShape(Optional xTop As Single = -1)`
`    Dim sc As cShapeContainer, s As Shape, xNextTop As Single`

`    ' this would be the default call - place the frame at the place defined in the parameters`
`    If xTop = -1 Then`
`        xTop = paramFrameTop`
`    End If`
`    `
`    ' make a shape`
`    Set pShape = Plot.Worksheet.Shapes.AddShape(paramShapeType, paramFrameLeft, xTop, paramFrameWidth, MyShapeHeight)`
`    ' apply the format asked for in the parameters and add a label`
`    shapeTemplate pShape, paramShapeTemplate, Text`
`    `
`    With pShape`
`        ' we are going to group the shapes later - this is so we can find them`
`        .Name = nameStub & .Name`
`        `
`        If pscType = sctframe Then`
`            ' width and left are all ok`

`        Else`
`            ' we have to calculate width and start point using dates relative to scale`
`            ' we'll replace these 100 when we figure out how`
`            .Width = 100`
`            .Left = 100`
`        End If`

`    End With`
`    `
`    ' this is where it gets tricky`
`    xNextTop = pShape.Top`
`    If MyExpansion Then`
`        ' if we are allowing expansion of targets then need to make a gap to accommodate my children`
`        xNextTop = xNextTop + MyGapBeforeChildren`
`    End If`
`    `
`    For Each sc In pChildren`
`        ' make a shape for each of my children`
`        sc.makeShape xNextTop`
`        ' figure out how much space my child needed and start the next one after it`
`        xNextTop = xNextTop + sc.MySpace`
`    Next sc`

`End Sub`

#### Next steps

The next recursion topic will be sorting. Sorting is a classic instance of recursion. Our roadmapper is going to need the capability to sort the items in various ways to allow the most effective presentation. In the next section, we will cover how to sort a collection, using recursion.

#### Complete code so far - version 4

The code is getting rather large now. You can replace the Roadmapper module and the cShapeContainer class with the code below, or go to the downloadable items page and pick up version 4.

`Option Explicit`
`Public Sub RoadMapper()`
`    Dim dSets As cDataSets`

`    Dim rData As Range, rParam As Range, rplot As Range`
`    Set rData = Range("InputData!\$a\$1:\$e\$1")`
`    Set rParam = Range("Parameters!\$a:\$g")`
`    Set rplot = Range("inputdata!a1")`
`    ' get the data and the parameters`
`    Set dSets = New cDataSets`
`    With dSets`
`        .create`
`        .init rData, , "data"`
`        .init rParam, , , True, "roadmap colors"`
`        .init rParam, , , True, "containers"`
`        .init rParam, , , True, "options"`
` `
`    End With`
`    '--check reading parameters worked----------------------------------------`
`    Debug.Print dSets.DataSet("options").Value("chart style", "value")`
`    Debug.Print dSets.DataSet("roadmap colors").Value("current", "shape")`
`    Debug.Print dSets.DataSet("containers").Value("frame", "comments")`
` `
`    '-----------------------------------------------------------------`
`    With dSets.DataSet("data")`
`        If .Where Is Nothing Then`
`            MsgBox ("No data to process")`
`        Else`
`            ' check we have fields we need`
`            If .HeadingRow.Validate(True, "Activate", "Deactivate", "ID", "Target", "Description") Then`
`                `
`                Call doTheMap(dSets, rplot)`
`            End If`
`        End If`
`    End With`

`End Sub`
`Private Sub doTheMap(ByRef dSets As cDataSets, rplot As Range)`

`    Dim scRoot As cShapeContainer, sc As cShapeContainer, dr As cDataRow`
`    `
`    ' this will be the root - the frame`
`    Set scRoot = New cShapeContainer`
`    scRoot.create scRoot, , rplot, dSets`
`    `
`    With dSets.DataSet("data")`
`    ' create for each datarow`
`        For Each dr In .Rows`
`            Set sc = scRoot.Find(dr.toString("ID"))`
`            If sc Is Nothing Then`
`                Set sc = New cShapeContainer`
`                sc.create scRoot, dr`
`                scRoot.Children.Add sc, sc.ID`
`            Else`
`                MsgBox sc.ID & " is a duplicate - skipping"`
`            End If`
`        Next dr`
`    End With`
`    `
`    ' sort out the parent/child relationships and delete all the existing shapes on this sheet`
`    scRoot.SpringClean`
`    `
`    ' plot the shapes and group them`
`    scRoot.makeShape`
`    scRoot.groupContainers`
`    `
`    'debug to see what that all looks like`
`    scRoot.debugReport`
`End Sub`

cShapeContainer Class
`' cShapeContainer Class`
`Option Explicit`
`Option Compare Text`

`Public Enum scTypeS`
`     sctData`
`     sctframe`
`End Enum`

`Public Enum ShapeTypes`
`    stPentagon = msoShapePentagon`
`    stRectangle = msoShapeRectangle`
`    stDefault = msoShapeRectangle`
`    stRoundedRectangle = msoShapeRoundedRectangle`
`    stChevron = msoShapeChevron`
`    stNotchedRightArrow = msoShapeNotchedRightArrow`
`    stRightArrow = msoShapeRightArrow`
`    stRightArrowCallout = msoShapeRightArrowCallout`
`End Enum`

`Const nameStub = "_rm_"`
`Const FrameID = "_frame_"`
`Private pscType As scTypeS`
`Private pShape As Shape`
`Private pDataRow As cDataRow`
`Private pChildren As Collection`
`Private pRoot As cShapeContainer`
`Private pParent As cShapeContainer`
`Private pdSets As cDataSets`
`Private pWhere As Range`
`Public Property Get Plot() As Range`
`    Set Plot = pRoot.Where`
`End Property`
`Public Property Get Where() As Range`
`    Set Where = pWhere`
`End Property`
`Public Property Get dSets() As cDataSets`
`    Set dSets = pRoot.dsetCollection`
`End Property`
`Public Property Get dsetCollection() As cDataSets`
`    Set dsetCollection = pdSets`
`End Property`
`Public Property Get scType() As scTypeS`
`    scType = pscType`
`End Property`
`Public Property Get Shape() As Shape`
`    Set Shape = pShape`
`End Property`
`Public Property Get root() As cShapeContainer`
`    Set root = pRoot`
`End Property`
`Public Property Set Shape(p As Shape)`
`    Set pShape = p`
`End Property`
`Public Property Get Children() As Collection`
`    Set Children = pChildren`
`End Property`
`Public Property Get Parent() As cShapeContainer`
`    Set Parent = pParent`
`End Property`
`Public Property Set Parent(p As cShapeContainer)`
`    Set pParent = p`
`End Property`
`Public Property Get ID() As String`
`    ID = fetchKey("ID")`
`End Property`

`' if parent is confirmed use the parents ID, otherwise go to the data. If blank, use the frame as the target`
`Public Property Get target() As String`
`    Dim s As String`
`    If Valid Then`
`        s = pParent.ID`
`    Else`
`        s = fetchKey("Target")`
`        If s = vbNullString Then`
`            s = pRoot.ID`
`        End If`
`    End If`
`    target = s`
`End Property`

`' pick up the text from the data, or provide a default value for the frame`
`Public Property Get Text() As String`
`    If pDataRow Is Nothing Then`
`        Debug.Assert pscType = sctframe`
`        Text = "Roadmap Frame"`
`    Else`
`        Debug.Assert pscType = sctData`
`        Text = pDataRow.toString("Description")`
`    End If`
`End Property`

`' doesnt become valid until a parent is confirmed`
`Public Property Get Valid() As Boolean`
`    Valid = (Not pParent Is Nothing)`
`End Property`

`' goto the data, or use a default value if the frame`
`Private Function fetchKey(s As String) As String`
`    If pDataRow Is Nothing Then`
`        Debug.Assert pscType = sctframe`
`        fetchKey = FrameID`
`    Else`
`        Debug.Assert pscType = sctData`
`        fetchKey = makekey(pDataRow.toString(s))`
`    End If`
`End Function`
`' this is the gap parameter for the gap for this shape`
`Private Property Get paramGap() As Single`
`    paramGap = Param("containers", "gap", "value")`
`End Property`
`' this is the expansion amount parameter for this shape`
`Private Property Get paramExpansion() As Boolean`
`    paramExpansion = ParamYesNo("containers", "allow expansion", "value")`
`End Property`
`' this is the parameter for the height of the shape`
`Private Property Get paramHeight() As Single`
`    paramHeight = Param("containers", "height", "value")`
`End Property`
`' this is the  parameter for the width of the frame`
`Private Property Get paramFrameWidth() As Single`
`    paramFrameWidth = Param("containers", "width", "value")`
`End Property`
`' this is the  parameter for the left position of the frame`
`Private Property Get paramFrameLeft() As Single`
`    paramFrameLeft = Param("containers", "left", "value")`
`End Property`
`' this is the  parameter for the left position of the frame`
`Private Property Get paramFrameTop() As Single`
`    paramFrameTop = Param("containers", "top", "value")`
`End Property`
`' this is the  parameter for the shape to use`
`Private Property Get paramShapeType() As ShapeTypes`
`    Dim s As String`
`    s = Param("roadmap colors", "current", "shape")`
`    paramShapeType = whichShape(s)`
`End Property`
`' this is the  parameter for the shape to use`
`Private Property Get paramShapeTemplate() As Range`
`    Set paramShapeTemplate = ParamRange("roadmap colors", "current", "format")`
`End Property`
`' this is general purpose for dealing with yes/no`
`Private Property Get ParamYesNo(dsn As String, rid As Variant, sid As Variant) As Boolean`
`    ParamYesNo = (Param(dsn, rid, sid) = "yes")`
`End Property`
`' this is general purpose for getting any parameter`
`Private Property Get Param(dsn As String, rid As Variant, sid As Variant) As Variant`
`    Param = ParamCell(dsn, rid, sid).Value`
`End Property`
`' this is general purpose for getting any parameter`
`Private Property Get ParamCell(dsn As String, rid As Variant, sid As Variant) As cCell`
`    With dSets.DataSet(dsn)`
`        Set ParamCell = .Cell(rid, sid)`
`    End With`
`End Property`
`' this gets the range a value is on`
`Private Property Get ParamRange(dsn As String, rid As Variant, sid As Variant) As Range`
`    Set ParamRange = ParamCell(dsn, rid, sid).Where`
`End Property`
`' this is the gap after me`
`Public Property Get MyGapAfterMe() As Single`
`    MyGapAfterMe = paramGap`
`End Property`
`' the gap to leave before i plot my children if i have any`
`Public Property Get MyGapBeforeChildren() As Single`
`    If pChildren.Count > 0 Then`
`        MyGapBeforeChildren = paramGap`
`    Else`
`        MyGapBeforeChildren = 0`
`    End If`
`End Property`
`' how much to allow myself to expand`
`Public Property Get MyExpansion() As Boolean`
`    MyExpansion = paramExpansion`
`    If Not paramExpansion Then`
`        MyExpansion = biggestBranch() > 1`
`    End If`
`End Property`
`Public Property Get MySpace() As Single`
`    Dim sc As cShapeContainer`
`    Dim ht As Single`
`    If pChildren.Count = 0 Then`
`        ht = paramHeight + MyGapAfterMe`
`    Else`

`        If MyExpansion Then`
`            ht = ht + MyGapBeforeChildren`
`            For Each sc In pChildren`
`                ht = ht + sc.MySpace`
`            Next sc`
`            ht = ht + MyGapAfterMe()`
`        Else`
`           ht = paramHeight + MyGapAfterMe()`
`        End If`

`    End If`
`    MySpace = ht`
`End Property`
`Public Property Get MyShapeHeight() As Single`
`    MyShapeHeight = MySpace - MyGapAfterMe`
`End Property`
`' calculate the longest branch from here.`
`Public Function biggestBranch() As Long`
`    Dim sc As cShapeContainer`
`    Dim ht As Long, t As Long`
`    ht = pChildren.Count`
`    For Each sc In pChildren`
`       t = sc.biggestBranch()`
`       If t > ht Then`
`        ht = t`
`       End If`
`    Next sc`
`    biggestBranch = ht`
`End Function`
`' this is the most complex part - creating the shapes of the correct size and placing them in the right spot`
`Public Sub makeShape(Optional xTop As Single = -1)`
`    Dim sc As cShapeContainer, s As Shape, xNextTop As Single`

`    ' this would be the default call - place the frame at the place defined in the parameters`
`    If xTop = -1 Then`
`        xTop = paramFrameTop`
`    End If`
`    `
`    ' make a shape`
`    Set pShape = Plot.Worksheet.Shapes.AddShape(paramShapeType, paramFrameLeft, xTop, paramFrameWidth, MyShapeHeight)`
`    ' apply the format asked for in the parameters and add a label`
`    shapeTemplate pShape, paramShapeTemplate, Text`
`    `
`    With pShape`
`        ' we are going to group the shapes later - this is so we can find them`
`        .Name = nameStub & .Name`
`        `
`        If pscType = sctframe Then`
`            ' width and left are all ok`

`        Else`
`            ' we have to calculate width and start point using dates relative to scale`
`            ' we'll replace these 100 when we figure out how`
`            .Width = 100`
`            .Left = 100`
`        End If`

`    End With`
`    `
`    ' this is where it gets tricky`
`    xNextTop = pShape.Top`
`    If MyExpansion Then`
`        ' if we are allowing expansion of targets then need to make a gap to accommodate my children`
`        xNextTop = xNextTop + MyGapBeforeChildren`
`    End If`
`    `
`    For Each sc In pChildren`
`        ' make a shape for each of my children`
`        sc.makeShape xNextTop`
`        ' figure out how much space my child needed and start the next one after it`
`        xNextTop = xNextTop + sc.MySpace`
`    Next sc`

`End Sub`
`' call to set to initial values`
`Public Function create(rt As cShapeContainer, Optional pr As cDataRow = Nothing, _`
`                        Optional rplot As Range = Nothing, Optional dss As cDataSets = Nothing)`
`    If pr Is Nothing Then`
`        pscType = sctframe`
`    Else`
`        pscType = sctData`
`    End If`
`    Set pDataRow = pr`
`    Set pRoot = rt`
`    Set pWhere = rplot`
`    Set pdSets = dss`
`    Set pChildren = New Collection`
`End Function`

`' call after all data is loaded to make parent.children associations`
`Public Sub SpringClean()`
`    Debug.Assert pscType = sctframe`
`    Associate`
`    deleteAllShapes Plot, nameStub`
`End Sub`

`' check if this ChildExists in current children`
`Public Function ChildExists(v As Variant) As cShapeContainer`
`    On Error GoTo handle`
`    Set ChildExists = pChildren(makekey(v))`
`    Exit Function`
`handle:`
`    Set ChildExists = Nothing`
`End Function`

`' standardize way of treating string items as keys to avoid case problems`
`Private Function makekey(v As Variant) As String`
`    makekey = LCase(Trim(CStr(v)))`
`End Function`

`' Find object by ID`
`Public Function Find(vId As Variant) As cShapeContainer`
`    Dim sc As cShapeContainer, scFound As cShapeContainer`
`    `
`    Set scFound = ChildExists(vId)`
`    ' it wasnt in my children .. see if its in my childrens children etc`
`    If scFound Is Nothing Then`
`        For Each sc In pChildren`
`            Set scFound = sc.Find(vId)`
`            If Not scFound Is Nothing Then`
`                Exit For`
`            End If`
`        Next sc`
`    End If`
`    Set Find = scFound`
`End Function`

`' one off reassociation of items from the root to be children of their target`
`' no need for recursion since to start with all are associated with the top level frame`
`Private Sub Associate()`

`    Debug.Assert pscType = sctframe`
`    `
`    Dim scParent As cShapeContainer, scChild As cShapeContainer, n As Long`
`    `
`    For Each scParent In pChildren`
`        ' who has me as their target?`
`        For Each scChild In pChildren`
`            If scChild.target = scParent.ID Then`
`                scParent.Children.Add scChild, scChild.ID`
`                ' confirm the parent as found`
`                Set scChild.Parent = scParent`
`            End If`
`        Next scChild`
`    Next scParent`
`    `
`' now all we need to do is clean up the children of the frame`
`    n = pChildren.Count`
`    While n > 0`
`        Set scChild = pChildren(n)`
`        If Not scChild.Valid Then`
`        ' we get here because we didnt find a target yet`
`            If scChild.target <> ID Then`
`            ' and it wasnt the frame.. so`
`                MsgBox ("Did not find target " & scChild.target & " for ID " & scChild.ID)`
`            End If`
`            ' confirm the frame as the parent`
`            Set scChild.Parent = Me`

`        Else`
`        ' remove from the frames children as already now child of someone else`
`            pChildren.Remove (n)`
`        `
`        End If`
`        ' belt and braces`
`        Debug.Assert scChild.Valid`
`        n = n - 1`
`    Wend`
`End Sub`
`Private Function whichShape(s As String) As ShapeTypes`
`    `
`    Select Case LCase(s)`
`        Case "pentagon"`
`            whichShape = stPentagon`
`        Case "rectangle"`
`            whichShape = stRectangle`
`        Case "rounded rectangle"`
`            whichShape = stRoundedRectangle`
`        Case "chevron"`
`            whichShape = stChevron`
`        Case "notched right arrow"`
`            whichShape = stNotchedRightArrow`
`        Case "right arrow"`
`            whichShape = stRightArrow`
`        Case "right arrow callout"`
`            whichShape = stRightArrowCallout`
`            `
`        Case Else`
`            whichShape = stDefault`
`            MsgBox ("Used default - cant find shape " & s)`
`            `
`    End Select`
`End Function`
`' apply format from a template cell`
`Private Sub shapeTemplate(s As Shape, ft As Range, tx As String)`
`    With s.TextFrame.Characters`
`        .Text = tx`
`        .Font.Color = ft.Font.Color`
`        .Font.Size = ft.Font.Size`
`        s.TextFrame.HorizontalAlignment = ft.HorizontalAlignment`
`        s.TextFrame.VerticalAlignment = ft.VerticalAlignment`
`        s.Fill.ForeColor.RGB = ft.Interior.Color`
`    End With`
`End Sub`
`Public Sub debugReport()`
`    Dim sc As cShapeContainer`
`    `
`    If pChildren.Count = 0 Then`
`        Debug.Print "--Nochildren:" & ID & ":Target:" & target`
`    Else`
`        Debug.Print "Parent:" & ID & ": has " & CStr(pChildren.Count) & " children"`

`        For Each sc In pChildren`
`            Debug.Print "--:report on child:" & sc.ID & " of " & ID`
`            sc.debugReport`
`        Next sc`
`    End If`

`End Sub`

`Public Function groupContainers() As Shape`
`    Dim sr As ShapeRange`
`    Dim sarg As String`
`    Set sr = makearangeofShapes(Where, nameStub)`
`    Set groupContainers = sr.Group`
`    `
`End Function`