Option Compare Database
Const bWidth As Single = 3
Const bHeight As Single = 2.5
Const dWidth As Single = 0.8
Dim Printing As Boolean
Const PrinterWidth As Single = 30
Dim Rows(10) As Single
Function drwPositionPass1(Optional SendToPrinter As Boolean = False)
Printing = SendToPrinter
FindSize 1
End Function

Function drwPositionPass2(Optional SendToPrinter As Boolean = False)
FindPos 1, 2, 0
If SendToPrinter Then
'    FindPrinterPosX 1
'    FindPrinterPosY 1
End If

End Function

Function drwPositionPass3(Optional SendToPrinter As Boolean = False)
PutPos 1, SendToPrinter
End Function

Private Function FindSize(bPointer As Integer)
Dim i As Integer
Dim w As Single
Dim h As Single
With Blocks(bPointer)
w = 0
h = 0
If (.nActiveSubBlocks = 0 And Not Printing) Or .nSubBlocks = 0 Then
  .bHeight = bHeight
  .bWidth = bWidth + dWidth
ElseIf .BlockType = "Serial" Then
    For i = 1 To .nSubBlocks
        FindSize .SubBlocks(i)
        w = w + Blocks(.SubBlocks(i)).bWidth + dWidth
        h = mx(h, Blocks(.SubBlocks(i)).bHeight)
    Next i
    .bHeight = h
    .bWidth = w
Else
    If .BlockType = "Component" Then .BlockType = "Parallel"
    For i = 1 To .nSubBlocks
        FindSize .SubBlocks(i)
        w = mx(w, Blocks(.SubBlocks(i)).bWidth + dWidth)
        h = h + Blocks(.SubBlocks(i)).bHeight
    Next i
    .bHeight = h
    .bWidth = w
End If
End With
End Function
Private Function FindPrinterPosX(bPointer As Integer)
Dim i As Integer
Dim r As Integer
With Blocks(bPointer)
    r = Int(.bLeft / PrinterWidth)
    .bLeft = .bLeft - r * PrinterWidth
    .bRowNumber = r
    For i = 1 To .nSubBlocks
        FindPrinterPosX .SubBlocks(i)
    Next i
End With
End Function

Private Function FindPrinterPosY(bPointer As Integer)
Dim i As Integer
Dim r As Integer
With Blocks(bPointer)
    r = Int(.bLeft / PrinterWidth)
    .bTop = .bTop + FindMaxY(1, .bRowNumber, 0)
    For i = 1 To .nSubBlocks
        FindPrinterPosY .SubBlocks(i)
    Next i
End With
End Function
Private Function FindMaxY(bPointer As Integer, r As Integer, MaxY As Single)
Dim i As Integer
Dim y As Single
If r = 0 Then
    FindMaxY = 0
Else
    With Blocks(bPointer)
    y = MaxY
    For i = 1 To .nSubBlocks
        y = FindMaxY(.SubBlocks(i), r, y)
    Next i
    If .bRowNumber = r Then
      y = mx(.bTop + .bHeight, y)
    End If
    FindMaxY = mx(MaxY, y)
    End With
End If
End Function

Private Function FindPos(bPointer As Integer, Left As Single, Top As Single)
Dim i As Integer
Dim l As Single
Dim t As Single
With Blocks(bPointer)
l = Left + dWidth / 2
t = Top
.bLeft = Left + dWidth / 2
.bTop = Top


If (.nActiveSubBlocks = 0 And Not Printing) Or .nSubBlocks = 0 Then
' Do nothing
ElseIf .BlockType = "Serial" Then
    For i = 1 To .nSubBlocks
   'Debug.Print .BlockName
    
        t = Top + (.bHeight - Blocks(.SubBlocks(i)).bHeight) / 2
        FindPos .SubBlocks(i), l, t
        l = l + Blocks(.SubBlocks(i)).bWidth + dWidth
        
    Next i
Else
    For i = 1 To .nSubBlocks
        l = Left + (.bWidth - Blocks(.SubBlocks(i)).bWidth) / 2
        FindPos .SubBlocks(i), l, t
        t = t + Blocks(.SubBlocks(i)).bHeight
    Next i
End If
.bRowNumber = Int(.bLeft / PrinterWidth)
End With
End Function

Private Function PutPos(bPointer As Integer, Optional SendToPrinter As Boolean = False)
Dim i As Integer
Dim w As Single
Dim h As Single
Dim x As Single
Dim y As Single
Dim MaxY As Single
Dim MinY As Single
With Blocks(bPointer)
w = 0
h = 0

If (.nActiveSubBlocks = 0 And Not Printing) Or .nSubBlocks = 0 Then
    If SendToPrinter Then
        SVGRect .bLeft + dWidth / 2, .bTop + 0.5, 3, 1.5
        SVGTxtWrap .bLeft + dWidth / 2 + 0.1, .bTop + 0.75, .BlockName, 10
        
        SVGTxt .bLeft + 1.2, .bTop - 0.4, FormatKooN(Blocks(bPointer).BlockType, Blocks(bPointer).k, _
        Blocks(bPointer).nSubBlocks, Blocks(bPointer).n)

    Else
        .ShowKooNCtl = _
        drwTxt(FormatKooN(Blocks(bPointer).BlockType, Blocks(bPointer).k, _
        Blocks(bPointer).nSubBlocks, Blocks(bPointer).n), _
        .bLeft + 1.2, .bTop, 2, 1)
        
        Blocks(bPointer).CmdID = drwCmd(bPointer, .bLeft + dWidth / 2, .bTop + 0.75, 3, 1, .BlockName, _
        .Description, "RBDClick")
    End If
    If SendToPrinter Then
        SVGLine .bLeft + dWidth / 2, .bTop + 0.5 + 0.75, .bLeft, .bTop + 0.5 + 0.75
        SVGLine .bLeft + bWidth + dWidth / 2, .bTop + 0.5 + 0.75, .bLeft + bWidth + dWidth, .bTop + 0.5 + 0.75
  
    Else
    
        drwLine .bLeft + dWidth / 2, .bTop + 0.5 + 0.75, .bLeft, .bTop + 0.5 + 0.75
        drwLine .bLeft + bWidth + dWidth / 2, .bTop + 0.5 + 0.75, .bLeft + bWidth + dWidth, .bTop + 0.5 + 0.75
    End If
   If .nSubBlocks > 0 And .nSubBlocks > 0 Then
     drwExpand bPointer, .bLeft - dWidth / 4, .bTop + 0.85, "Expand block to the right", "RBDExpand", Printing
   End If
ElseIf .BlockType = "Serial" Then
    y = .bTop + .bHeight / 2
    x = .bLeft
    For i = 1 To .nSubBlocks
        PutPos .SubBlocks(i), SendToPrinter
        If SendToPrinter Then
            SVGLine x, y, x + dWidth / 2, y
        Else
            drwLine x, y, x + dWidth / 2, y
        End If
        x = x + Blocks(.SubBlocks(i)).bWidth + dWidth
        If SendToPrinter Then
            SVGLine x, y, x - dWidth / 2, y
        Else
            drwLine x, y, x - dWidth / 2, y
        End If
    Next i
    y = .bTop + .bHeight / 2.04
    x = .bLeft
    If bPointer > 0 Then Colapse bPointer, x, y, _
    FormatKooN(Blocks(bPointer).BlockType, Blocks(bPointer).k, _
        Blocks(bPointer).nSubBlocks, Blocks(bPointer).n)
Else
    MaxY = 0
    MinY = 1E+30
    y = .bTop + .bHeight / 2
    x = .bLeft
    For i = 1 To .nSubBlocks
        y = Blocks(.SubBlocks(i)).bTop + Blocks(.SubBlocks(i)).bHeight / 2
        If SendToPrinter Then
            SVGLine .bLeft, y, Blocks(.SubBlocks(i)).bLeft, y
            SVGLine .bLeft + .bWidth, y, Blocks(.SubBlocks(i)).bLeft + Blocks(.SubBlocks(i)).bWidth, y
        Else
            drwLine .bLeft, y, Blocks(.SubBlocks(i)).bLeft, y
            drwLine .bLeft + .bWidth, y, Blocks(.SubBlocks(i)).bLeft + Blocks(.SubBlocks(i)).bWidth, y
        End If
        PutPos .SubBlocks(i), SendToPrinter
        
        MaxY = mx(MaxY, y)
        MinY = mi(MinY, y)
    Next i
    If SendToPrinter Then
        SVGLine .bLeft, MinY, .bLeft, MaxY
        SVGLine .bLeft + .bWidth, MinY, .bLeft + .bWidth, MaxY
    Else
        drwLine .bLeft, MinY, .bLeft, MaxY
        drwLine .bLeft + .bWidth, MinY, .bLeft + .bWidth, MaxY
    End If
    y = .bTop + .bHeight / 2.04
    x = .bLeft
    If bPointer > 0 Then Colapse bPointer, x, y, _
    FormatKooN(Blocks(bPointer).BlockType, Blocks(bPointer).k, _
        Blocks(bPointer).nSubBlocks, Blocks(bPointer).n)
End If
End With
End Function


Static Function mx(A As Single, B As Single)
mx = IIf(A > B, A, B)
End Function
Static Function mi(A As Single, B As Single)
mi = IIf(A < B, A, B)
End Function


Static Function Expand(bPointer As Integer, Left As Single, Mid As Single)
Dim Top As Single
Top = Mid - 0.3
'Left = Left + 0.7
drwExpand bPointer, Left - 0.3, Top, "Expand block to the right", "RBDExpand", Printing

End Function

Static Function Colapse(bPointer As Integer, Left As Single, Mid1 As Single, Optional KooNString As String)
Dim Top As Single
Dim k As Integer
Dim n As Integer

Top = Mid1 - 0.3
'Left = Left + 0.7

If Printing Then
    
    k = kFromKooN(KooNString)
    n = nFromKooN(KooNString)
    If k > 1 And k < n Then
        SVGTxt Left, Mid1 - 0.75, "k="
        SVGTxt Left, Mid1 - 0.08, Format(k)
    End If
End If

drwColapse bPointer, Left - 0.3, Top, "Colapse blocks to the right (" & KooNString & ")", "RBDColapse", Printing

End Function