PC World Komputer 1997 February/PCWK0297.iso/lotus/english/lotus039.dsk/GTSCRPT.LSS

Text File | 1995-10-04 | 38.7 KB | 935 lines

OPTION DECLARE                          '// force explicit delcaration of variables
Use "gtscrpt2"


'//-------------------------------------------------------------------------------------
'// Goals script
'//-------------------------------------------------------------------------------------

'// sets new coordinates for GoalInfo (for dgm's that have
'// text shapes positioned vertically) - does not store text
'//--------------------------------------------------------------------------------
Public SUB FindTopDownTextShapes(GoalInfo() As GoalsStruct, ScriptID As Integer)
   Dim    Index            As Integer,        _
           Count            As Integer,        _
           i                As Integer,        _
            ArraySize    As Integer


    If(ScriptID = ObjectivesScript) Then
        ArraySize = MaxObjectives
    ElseIf(ScriptID = PyramidScript) Then
        ArraySize = MaxPyramidEvents
    End If

    For i = 1 To (ArraySize)                                            '// zero out all position information
        GoalInfo(i).Position = 0                                        '// in case it has info about old diagrams
    Next i

   Count = 0
   ForAll Object in Selection.SelectedObjects
        If(Object.IsText) Then                                            '// sorts by left coordinate of each text shape found
            Index = Count
            If(Count <> 0) Then
                While((GoalInfo(Index).Position < Object.Top) AND (Index > 0))
                    GoalInfo(Index+1).Position = GoalInfo(Index).Position
                    Index = Index - 1
                Wend
            End If
            GoalInfo(Index+1).Position = Object.Top
            Count = Count + 1
        End If
   End ForAll
END SUB


'// Finds specified goal among currently selected DrawObject's
Public FUNCTION SelectLevel(index As Integer, GoalInfo() As GoalsStruct) AS DrawObject
   ForAll Object in Selection.SelectedObjects
      If(Object.isText AND Object.top = GoalInfo(index).position) Then
         set SelectLevel = Object
         Exit ForAll
      End If
   End ForAll
END FUNCTION

'// Finds specified goal among currently selected DrawObject's
PRIVATE FUNCTION SelectGoal(index As Integer, GoalInfo() As GoalsStruct) AS DrawObject
   ForAll Object in Selection.SelectedObjects
      If(Object.isText AND Object.top = GoalInfo(index).position) Then
         set SelectGoal = Object
         Exit ForAll
      End If
   End ForAll
END FUNCTION

'// Initializes array of objectives, fills array with text, also used by Send Email script
'//     InPuts:
'//    OutPuts:    GoalInfo()    - array of GoalsSruct's filled in with position and text of each objective
'//                Count            - Number of Objectives found
'//                NumGoals        - Number of calculated Objectives (based upon grouping assumptions of diagrams in branch.dgm)
'//    Returns:    DrawObject
'//------------------------------------------------------------------------------------------------------------------------
PUBLIC FUNCTION InitGoalsInfo(GoalInfo() As GoalsStruct, Count As Integer, _
                                            DefaultButton As Integer, NumGoals As Integer) As _
                                            DrawObject
    Dim    i            As Integer,        _
            Index        As Integer,        _
            x            As Integer,        _
            Temp        As DrawObject, _
            Goals        As DrawObject


    For x = 1 to MaxObjectives                                     '// Init array of GoalsStruct's
      GoalInfo(x).position = 0
      GoalInfo(x).Text = ""
   Next x
    Set Temp = CurrentPage.FindObject(GoalsDgmName)          '// find goals diagram
   Set Goals = Temp.Replicate()                                '// take dgm out of pb to ungroup
   Temp.Cut                                                    '// delete dgm in pb
    Selection.ClearSelection
   Goals.Ungroup                                               '// ungroup dgm copied - not in pb

   If(Selection.SelectionCount < 3 OR Selection.SelectionCount > 12) Then
      MessageBox InvalidDiagram, 0, ErrorMsg                        '// Check for invalid diagram
      EndScript
   End If

   SELECT CASE(Selection.SelectionCount)                      '// Find number of goals
      Case 3: NumGoals = 2
      Case 4: NumGoals = 3
      Case 5: NumGoals = 4
      Case 6: NumGoals = 5
      Case 7: NumGoals = 6
      Case 8: NumGoals = 7
   END SELECT

   If(NumGoals = MaxObjectives) Then                                  '// if 7 goals default radio button for delete to be selected
      DefaultButton = 1
   Else                                                                '// otherwise default to add
      DefaultButton = 0
   End If

   Count = 0
   ForAll Obj in Selection.SelectedObjects                       '// finds text shapes and stores text
        If(Obj.IsText) Then                                                '// sorts by top coordinate of each text shape found
            Index = Count
            If(Count <> 0) Then
                While((GoalInfo(Index).Position < Obj.Top) AND (Index > 0))
                    GoalInfo(Index+1) = GoalInfo(Index)
                    Index = Index - 1
                Wend
            End If
            GoalInfo(Index+1).Position = Obj.Top
            GoalInfo(Index+1).Text = Obj.Text
            Count = Count + 1
    For  x = 1 to Count
    print GoalInfo(x).text, GoalInfo(x).position
    next x
    print "------------"
        End If
   End ForAll

print "count=",count
   Set InitGoalsInfo = Selection.Group()
END FUNCTION


Public SUB Objectives(bSAlliance As Integer)
   Dim    PackedVal        As Long,            _
           DgmPath            As String,        _
           x                    As Integer,        _
           i                    As Integer,        _
           j                    As Integer,        _
           Count                As Integer,        _
           NumToAdd            As Integer,        _
           NumToDel            As Integer,        _
           NumGoals            As Integer,        _
           DefaultButton    As Integer,        _
            MaxSpinnerVal    As Integer,        _
           Temp                As DrawObject,    _
           Goals                As DrawObject,    _
           GoalInfo(MaxObjectives) As GoalsStruct


      Set Goals = InitGoalsInfo(GoalInfo(), Count, DefaultButton, NumGoals)

   If(Count > NumGoals) Then                                            '//  if diagram has incorrect layout, too much text
      MESSAGEBOX InvalidDiagram, 0, ErrorMsg
   Else
      DgmPath = [Freelance].Preferences.TemplateDir + BranchDgmFileName

        If(NumGoals = MaxObjectives) Then
            MaxSpinnerVal = MaxObjectives
        Else
            MaxSpinnerVal = NumGoals + 1
        End If

      '// Strategic Alliance needs different wording, so depending on flag launch dlg appropriately
        If(bSAlliance = 0) Then
            PackedVal = CurrentDocument.RunDialog(1, ObjDlgTitle, DiagramNote, ObjAddQuestion, _
                                                ObjDelQuestion, DefaultButton, NULLSTR, _
                                                NULLSTR, "1", STR$(MaxSpinnerVal), 1, _
                                                NumGoals)
        Else
          PackedVal = CurrentDocument.RunDialog(1, GoalDlgTitle, DiagramNote, GoalAddQuestion, _
                                                     GoalDelQuestion, DefaultButton, NULLSTR, _
                                                    NULLSTR, "1", STR$(MaxSpinnerVal), 1, _
                                                    NumGoals)
        End If


      If((PackedVal AND BitField9) = BitField9) Then                    '// User ok'd dlg
         If((PackedVal AND BitField8) <> BitField8) Then          '// ADD Goal
               NumToAdd = PackedVal AND BitFields0To7
               If((NumToAdd > 0) AND (NumToAdd <= 7)) Then
                  If(NumGoals = MaxObjectives) Then                   '// too many objectives, can't add
                     MESSAGEBOX AddError, 0, ErrorMsg
                     Goals.PutIntoPlacementBlock(DgmPBID)
                     Goals.name = GoalsDgmName                        '// so we can find it later
               Else
                     Goals.Cut                                           '// delete old diagram
                     set Goals = CurrentPage.CreateSymbol(DgmPath, NumGoals)
                     Selection.ClearSelection
                     Goals.Ungroup

                     FindTopDownTextShapes GoalInfo(), ObjectivesScript    '// Find coordinates for each objective and sort

                  x = NumGoals + 1                                            '// add new objective in array
                     WHILE(x > NumToAdd)
                        GoalInfo(x).Text = GoalInfo(x-1).Text
                        x = x - 1
                     WEND
                      GoalInfo(NumToAdd).Text = ""                     '// not necessary since not used, but
                                                                        '// just to be safe
                  For x = 1 TO (NumToAdd -1)                           '// re-insert old objectives
                        set Temp = SelectGoal(x, GoalInfo())
                            If(StrCompare(GoalInfo(x).Text, NULLSTR)) Then    '// Don't replace with Null String,
                            Temp.Text = GoalInfo(x).Text                        '// removes prompt text
                            End If
                     Next x
                       For x = (NumToAdd+1) TO (NumGoals+1)
                        set Temp = SelectGoal(x, GoalInfo())
                            If(StrCompare(GoalInfo(x).Text, NULLSTR)) Then    '// Don't replace with Null String,
                            Temp.Text = GoalInfo(x).Text                        '// removes prompt text
                            End If
                  Next x
                      set Goals = Selection.Group()                     '// put pieces back together
                     Goals.PutIntoPlacementBlock(DgmPBID)
                     Goals.name = GoalsDgmName                        '// so we can find it later
                  End If
               End If
            Else                                                         '// delete an objective
               NumToDel = PackedVal AND BitFields0To7
            If(NumGoals = MinObjectives) Then
                  MESSAGEBOX DeleteError, 0, ErrorMsg
                  Goals.PutIntoPlacementBlock(DgmPBID)                   '// restore objective in pb
                    Goals.name = GoalsDgmName                            '// so we can find it later
               ElseIf((NumToDel <= NumGoals) AND (NumToDel > 0)) Then
                  Goals.Cut
               set Goals = CurrentPage.CreateSymbol(DgmPath, NumGoals-2)
                    Selection.ClearSelection
                  Goals.Ungroup

                  FindTopDownTextShapes GoalInfo(), ObjectivesScript    '// Find coordinates for each objective and sort

               For x = NumToDel TO (NumGoals - 1)                        '// delete objective in array of GoalStruct's
                     GoalInfo(x).Text = GoalInfo(x+1).Text
                  Next x
                   GoalInfo(NumGoals).Text = ""                       '// clear last item in array

               For x = 1 TO (NumGoals - 1)                            '// re-insert old objectives
                        set Temp = SelectGoal(x, GoalInfo())
                        If(StrCompare(GoalInfo(x).Text, NULLSTR)) Then    '// Don't replace with Null String,
                         Temp.Text = GoalInfo(x).text                        '// removes prompt text
                        End If
                  Next x

                Set Goals = Selection.Group()                         '// put pieces back together
                  Goals.PutIntoPlacementBlock(DgmPBID)
               Goals.name = GoalsDgmName                             '// so we can find later
             End If
            End If
        Else                                                                            '// user canceled out of dlg
             Goals.PutIntoPlacementBlock(101)                           '// so we can find it later
            Goals.name = GoalsDgmName                                  '// restore goal in pb
       End If
         Selection.ClearSelection
    End If
END SUB


Public Sub Goals()
    Objectives(0)
End Sub

'// wrapper so we know if we've been called from Strategic Alliance, in which case 'objectives' need to be 'goals'
'// Don't want ot changed API because then we would have to re-attach all scripts
Public Sub SA_Goals()
    Objectives(1)
End Sub


'//--------------------------------------------------------------------------------------
'// Pyramid script
'//--------------------------------------------------------------------------------------

PUBLIC SUB Pyramid()
   Dim    PackedVal        As Long,            _
           DgmPath            As String,        _
              NumLevels        As Integer,        _
            MaxSpinnerVal    As Integer,        _
           Count                As Integer,        _
           DefaultButton    As Integer,        _
           x                    As Integer,        _
           NumToAdd            As Integer,     _
            NumToDel            As Integer,        _
            i                    As Integer,        _
            Index                As Integer,        _
           Pyrmd                As DrawObject,    _
           Temp                As DrawObject,    _
           GoalInfo(MaxPyramidEvents)    As GoalsStruct


   For x = 1 to MaxPyramidEvents                             '// Init array of GoalsStruct's
      GoalInfo(x).position = 0
      GoalInfo(x).Text = ""
   Next x

   Set Temp = CurrentPage.FindObject(PyramidDgmName)        '// find goals diagram
   Set Pyrmd = Temp.Replicate()                            '// take dgm out of pb to ungroup
   Temp.Cut                                                '// delete dgm in pb
    Selection.ClearSelection
   Pyrmd.Ungroup                                           '// ungroup dgm copied - not in pb

   If(Selection.SelectionCount < 4 OR Selection.SelectionCount > 10) Then
      MessageBox InvalidDiagram, 0, ErrorMsg
      EndScript
   End If                                                         '// Checking for invalid diagram

   SELECT CASE(Selection.SelectionCount)                      '// Find number of Pyrmd
       Case 4: NumLevels = 2
       Case 6: NumLevels = 3
       Case 8: NumLevels = 4
       Case 10: NumLevels = 5
   END SELECT

   If(NumLevels = MaxPyramidEvents) Then                      '// if max sections default radio button for delete
      DefaultButton = 1
   Else                                                                '// otherwise default to add
      DefaultButton = 0
   End If

   Count = 0
   ForAll Obj In Selection.SelectedObjects                   '// finds text shapes and stores text
        If(Obj.IsText) Then                                            '// sorts by top coordinate of each text shape found
            Index = Count
            If(Count <> 0) Then
                While((GoalInfo(Index).Position < Obj.Top) AND (Index > 0))
                    GoalInfo(Index+1) = GoalInfo(Index)
                    Index = Index - 1
                Wend
            End If
            GoalInfo(Index+1).Position = Obj.Top
            GoalInfo(Index+1).Text = Obj.Text
            Count = Count + 1
    For  x = 1 to Count
    print GoalInfo(x).text, GoalInfo(x).position
    next x
    print "------------"
        End If
   End ForAll

print "count=",count

   set Pyrmd = Selection.Group()

   If(Count > NumLevels) Then                                '//  if diagram has incorrect layout, too much text
      MESSAGEBOX InvalidDiagram, 0, ErrorMsg
   Else
      DgmPath = [Freelance].Preferences.TemplateDir + PyramidDgmFileName

        If(NumLevels = MaxPyramidEvents) Then
            MaxSpinnerVal = MaxPyramidEvents
        Else
            MaxSpinnerVal = NumLevels + 1
        End If

      PackedVal = CurrentDocument.RunDialog(1, SectionDlgTitle, DiagramNote, SectionAddQuestion, SectionDelQuestion, _
                                                DefaultButton, NULLSTR, NULLSTR, "1", STR$(MaxSpinnerVal), 1, NumLevels)

      If((PackedVal AND 512) = 512) Then                                             '// User ok'd dlg
         If((PackedVal AND 256) <> 256) Then                                         '// ADD Goal
            NumToAdd = PackedVal AND 255
            If((NumToAdd > 0) AND (NumToAdd <= 7)) Then
               If(NumLevels = MaxPyramidEvents) Then                                '// too many Pyrmd, can't add
                  MESSAGEBOX AddError, 0, ErrorMsg
                   Pyrmd.PutIntoPlacementBlock(DgmPBID)                                 '// restore section in pb
                        Pyrmd.Name = PyramidDgmName                                       '// so we can find it later
                Else                                                                     '// add goal
                  Pyrmd.Cut                                                           '// remove old dgm
                  Set Pyrmd = CurrentPage.CreateSymbol(DgmPath, NumLevels)
                        Selection.ClearSelection
                  Pyrmd.Ungroup

                  FindTopDownTextShapes GoalInfo(), PyramidScript                    '// Find coordinates for each section
                                                                                                        '// and sort
                  x = NumLevels + 1                                                 '// add new section in array
                  WHILE(x > NumToAdd)
                     GoalInfo(x).Text = GoalInfo(x-1).Text
                     x = x - 1
                  WEND

                  GoalInfo(NumToAdd).Text = ""                                         '// not necessary since not used, but
                                                                                     '// just to be safe
                  For x = 1 TO (NumToAdd -1)                                         '// re-insert old sections
                     Set Temp = SelectLevel(x, GoalInfo())
                            If(StrCompare(GoalInfo(x).Text, NULLSTR)) Then                '// Don't replace with Null String,
                         Temp.Text = GoalInfo(x).Text                                    '// removes prompt text
                            End If
                  Next x
                  For x = (NumToAdd+1) TO (NumLevels+1)
                     Set Temp = SelectLevel(x, GoalInfo())
                            If(StrCompare(GoalInfo(x).Text, NULLSTR)) Then                '// Don't replace with Null String,
                         Temp.Text = GoalInfo(x).Text                                    '// removes prompt text
                            End If
                  Next x

                  set Pyrmd = Selection.Group()                                       '// put pieces back together
                  Pyrmd.PutIntoPlacementBlock(DgmPBID)                              '// assume pb has id of 101
                  Pyrmd.Name = PyramidDgmName                                        '// so we can find it later
               End If
            End If
         Else                                                                          '// delete goal
            NumToDel = PackedVal AND 255
            If(NumLevels = MinPyramidEvents) Then
               MESSAGEBOX DeleteError, 0, ErrorMsg
               Pyrmd.PutIntoPlacementBlock(DgmPBID)                                 '// restore goal in pb
                    Pyrmd.Name = PyramidDgmName                                            '// so we can find it later
            ElseIf ((NumToDel <= NumLevels) AND (NumToDel > 0)) Then
               Pyrmd.Cut
               Set Pyrmd = CurrentPage.CreateSymbol(DgmPath, NumLevels-2)
                    Selection.ClearSelection
               Pyrmd.Ungroup

               FindTopDownTextShapes GoalInfo(), PyramidScript                  '// Find coordinates for each section
                                                                                                        '//  and sort
               For x = NumToDel TO (NumLevels - 1)                                   '// delete goal in array of Pyrmdtruct's
                  GoalInfo(x).Text = GoalInfo(x+1).Text
               Next x

               GoalInfo(NumLevels).Text = ""                                         '// clear last item in array

               For x = 1 TO (NumLevels - 1)                                          '// re-insert old Pyrmd
                  Set Temp = SelectLevel(x, GoalInfo())
                        If(StrCompare(GoalInfo(x).Text, NULLSTR)) Then                    '// Don't replace with Null String,
                      Temp.Text = GoalInfo(x).Text                                        '// removes prompt text
                        End If
               Next x

               Set Pyrmd = Selection.Group()                                           '// put pieces back together
               Pyrmd.PutIntoPlacementBlock(DgmPBID)
               Pyrmd.Name = PyramidDgmName                                           '// so we can find later
            End If
         End If
      Else
         Pyrmd.PutIntoPlacementBlock(DgmPBID)                                        '// user canceled out of dlg
            Pyrmd.Name = PyramidDgmName                                                    '// restore dgm in pb
      End If
      Selection.ClearSelection
   End If
END SUB


'//--------------------------------------------------------------------------------------
'// Used by section scripts to find a particular section
'//--------------------------------------------------------------------------------------
Public FUNCTION SelectSegment(index As Integer, GoalInfo() As SegmentStruct) AS DrawObject
   ForAll Object in Selection.SelectedObjects
      If(Object.isText AND Object.Left = GoalInfo(index).LeftPos _
              AND Object.Top = Goalinfo(index).TopPos) Then
         set SelectSegment = Object
         Exit ForAll
      End If
   End ForAll
END FUNCTION


'//--------------------------------------------------------------------------------------
'// used by two column section scripts to sort array of sections
'//--------------------------------------------------------------------------------------
'// sets new coordinates for Level - does not store text
Public SUB FindSegmenttextShapes(GoalInfo() As SegmentStruct)
   Dim    Index    As Integer,    _
           Count As Integer,    _
           i        As Integer, _
            x as integer

    For x = 1 To MaxSegments
        GoalInfo(x).TopPos = 0
        GoalInfo(x).LeftPos = 0
    Next x

   Count = 0
   ForAll Object in Selection.SelectedObjects
      If(Object.IsText) Then
            Index = Count
         If(Count <> 0) Then
               While((Index > 0) AND (GoalInfo(Index).TopPos < Object.Top))
print "Index=",Index
                        GoalInfo(Index+1).TopPos = GoalInfo(Index).TopPos
                        GoalInfo(Index+1).LeftPos = GoalInfo(Index).LeftPos
                        Index = Index - 1
                Wend

                If(GoalInfo(Index).LeftPos > Object.Left) Then                        '// set to correct column
                    GoalInfo(Index+1).TopPos = GoalInfo(Index).TopPos
                    GoalInfo(Index+1).LeftPos = GoalInfo(Index).LeftPos
                    Index = Index - 1
                End If
            End If
            GoalInfo(Index+1).TopPos = Object.Top
            GoalInfo(Index+1).LeftPos = Object.Left
         Count = Count + 1

    For  x = 1 to Count
    print GoalInfo(x).Text, GoalInfo(x).leftpos, GoalInfo(x).TopPos
    next x
    print "------------"

      End If
   End ForAll
END SUB


'//--------------------------------------------------------------------------------------
'// Two column Segment script
'//--------------------------------------------------------------------------------------
PUBLIC SUB Segment()
   Dim     PackedVal        As Long,        _
           DgmPath            As String,    _
           MaxSpinnerVal    As Integer,    _
           MaxObjectCount    As Integer,    _
           MinObjectCount As Integer, _
           NumSections        As Integer, _
           Count                As Integer,    _
           DefaultButton    As Integer, _
           x                    As Integer, _
           NumToAdd            As Integer, _
            NumToDel            As Integer, _
            i                    As Integer, _
            Index                As Integer,    _
            MaxDeleteVal    As Integer, _
           Section            As DrawObject,    _
           Temp                As DrawObject,    _
           SectionInfo(MaxSegments)    As SegmentStruct


   MaxObjectCount = MaxSegments + 1
   MinObjectCount    = MinSegments + 1

   For x = 1 to MaxSegments                                 '// Init array of SegmentStruct's
        SectionInfo(x).LeftPos        = 0
        SectionInfo(x).TopPos         = 0
      SectionInfo(x).Text     = ""
   Next x

   Set Temp = CurrentPage.FindObject(SegmentDgmName)  '// find Section diagram
   Set Section = Temp.Replicate()                        '// take dgm out of pb to ungroup
   Temp.Cut                                            '// delete dgm in pb
    Selection.ClearSelection
   Section.Ungroup                                       '// ungroup dgm copied - not in pb

   If(Selection.SelectionCount < MinObjectCount OR Selection.SelectionCount > MaxObjectCount) Then
      MessageBox InvalidDiagram, 0, ErrorMsg
      EndScript
   End If                                                     '// Checking for invalid diagram

   SELECT CASE(Selection.SelectionCount)                  '// Find number of segments
       Case 5: NumSections = 4
       Case 7: NumSections = 6
       Case 9: NumSections = 8
       Case 11: NumSections = 10
       Case 13: NumSections = 12
   END SELECT

   If(NumSections = MaxSegments) Then                      '// if max number of segments, default to delete
      DefaultButton = 1
   Else                                                        '// otherwise default to add
      DefaultButton = 0
   End If

   Count = 0
   ForAll Obj In Selection.SelectedObjects               '// finds text shapes and stores text
      If(Obj.isText) Then
            Index = Count
         If(Count <> 0)    Then
               While((Index > 0) AND (SectionInfo(Index).TopPos < Obj.Top))    '// find a SectionInfo on same level
                    SectionInfo(Index+1) = SectionInfo(Index)
                    Index = Index - 1
                Wend
                If(SectionInfo(Index).LeftPos > Obj.Left) Then                        '// set to correct column
                    SectionInfo(Index+1) = SectionInfo(Index)
                    Index = Index - 1
                End If
            End If
            SectionInfo(Index+1).TopPos = Obj.Top
            SectionInfo(Index+1).LeftPos = Obj.Left
            SectionInfo(Index+1).Text = Obj.Text
         Count = Count + 1

    For  x = 1 to Count
    print SectionInfo(x).Text, SectionInfo(x).leftpos, SectionInfo(x).TopPos
    next x
    print "------------"

      End If
   End ForAll

   Set Section = Selection.Group()

   If(Count > NumSections) Then                                        '//  if diagram has incorrect layout, too much text
      MESSAGEBOX InvalidDiagram, 0, ErrorMsg
   Else
      DgmPath = [Freelance].Preferences.TemplateDir + SectionDgmFileName

        If(NumSections = MaxSegments) Then
            MaxSpinnerVal = (MaxSegments/2) - 1
        Else
            MaxSpinnerVal = (NumSections/2)
        End If

        MaxDeleteVal = (NumSections/2)-1
         PackedVal = CurrentDocument.RunDialog(1, SectionDlgTitle, DiagramNote, SectionAddQuestion, SectionDelQuestion, _
                                                DefaultButton, NULLSTR, NULLSTR, _
                                                "1", STR$(MaxSpinnerVal), 1, MaxDeleteVal)
print numsections
      If((PackedVal AND BitField9) = BitField9) Then               '// User ok'd dlg
         If((PackedVal AND BitField8) <> BitField8) Then           '// ADD section
            NumToAdd = PackedVal AND BitFields0To7
            If((NumToAdd > 0) AND (NumToAdd <= 7)) Then
               If(NumSections = MaxSegments) Then                   '// too many Section, can't add
                  MESSAGEBOX AddError, 0, ErrorMsg
                   Section.PutIntoPlacementBlock(DgmPBID)             '// restore dgm in pb
                        Section.Name = SegmentDgmName                      '// so we can find it later
                Else                                                     '// add goal
                  Section.Cut                                       '// remove old dgm
                  Set Section = CurrentPage.CreateSymbol(DgmPath, (NumSections/2)+16)
                        Selection.ClearSelection
                  Section.Ungroup

                  FindSegmentTextShapes SectionInfo()               '// Find coordinates for each section and sort

                        x = NumSections + 2                                        '// clear one more for a whole level
                        While(x > ((NumToAdd)*2)+1)
                            SectionInfo(x).Text = SectionInfo(x-2).Text
                            x = x - 1
                        Wend

                  SectionInfo((NumToAdd*2)+1).Text = ""             '// not necessary since not used, but just to be safe
                        SectionInfo((NumToAdd*2)+2).Text = ""

                  For x = 1 TO ((NumToAdd)*2)                          '// re-insert old Section
                     Set Temp = SelectSegment(x, SectionInfo())
                            If(StrCompare(SectionInfo(x).Text, NULLSTR)) Then    '// Don't replace text if No text, this will
                         Temp.Text = SectionInfo(x).Text                        '// keep prompt text
                            End If
                  Next x
                  For x = ((NumToAdd*2)+3) TO (NumSections+2)
                     Set Temp = SelectSegment(x, SectionInfo())
                            If(StrCompare(SectionInfo(x).Text, NULLSTR)) Then    '// Don't replace text if No text, this will
                         Temp.Text = SectionInfo(x).Text                        '// keep prompt text
                            End If
                  Next x

                  set Section = Selection.Group()                   '// put pieces back together
                  Section.PutIntoPlacementBlock(DgmPBID)              '// assume pb has id of 101
                  Section.Name = SegmentDgmName                      '// so we can find it later
               End If
            End If
         Else                                                        '// delete segment
            NumToDel = PackedVal AND BitFields0To7
            If(NumSections = MinSegments) Then
               MESSAGEBOX DeleteError, 0, ErrorMsg
               Section.PutIntoPlacementBlock(DgmPBID)                '// restore segment in pb
                    Section.Name = SegmentDgmName                         '// so we can find it later
            ElseIf ((NumToDel <= NumSections) AND (NumToDel > 0)) Then
               Section.Cut
               Set Section = CurrentPage.CreateSymbol(DgmPath, (NumSections/2)+14)
                    Selection.ClearSelection
               Section.Ungroup

               FindSegmentTextShapes SectionInfo()                     '// Find coordinates for each section and sort

               For x = ((NumToDel*2)+1) TO (NumSections-2)          '// delete segment in array of Sectiontruct's
                  SectionInfo(x).Text = SectionInfo(x+2).Text
               Next x

               SectionInfo(NumSections-1).Text = ""
               SectionInfo(NumSections).Text = ""                    '// clear last item in array

               For x = 1 TO (NumSections-2)                            '// re-insert old Section
                  Set Temp = SelectSegment(x, SectionInfo())
                        If(StrCompare(SectionInfo(x).Text, NULLSTR)) Then    '// Don't replace text if No text, this will
                      Temp.Text = SectionInfo(x).Text                        '// keep prompt text
                        End If
               Next x

               Set Section = Selection.Group()                       '// put pieces back together
               Section.PutIntoPlacementBlock(DgmPBID)
               Section.Name = SegmentDgmName                      '// so we can find later
            End If
         End If
      Else
         Section.PutIntoPlacementBlock(DgmPBID)                        '// user canceled out of dlg
            Section.Name = SegmentDgmName                                '// restore dgm in pb
      End If
      Selection.ClearSelection
   End If
END SUB


'//--------------------------------------------------------------------------------------
'// Three column Segment script
'//--------------------------------------------------------------------------------------

'// sets new coordinates for Level - does not store text
PRIVATE SUB Find3ColSection(SectionInfo() As SegmentStruct)
   Dim    Index    As Integer,    _
           Count As Integer,    _
           i        As Integer, _
            x as integer

    For x = 1 To MaxSegments
        SectionInfo(x).TopPos = 0
        SectionInfo(x).LeftPos = 0
    Next x

   Count = 0
   ForAll Object in Selection.SelectedObjects
      If(Object.IsText) Then
            Index = Count
         If(Count <> 0) Then
               While((Index > 0) AND (SectionInfo(Index).TopPos < Object.Top))
                        SectionInfo(Index+1).TopPos = SectionInfo(Index).TopPos
                        SectionInfo(Index+1).LeftPos = SectionInfo(Index).LeftPos
                        Index = Index - 1
                Wend
                If(SectionInfo(Index).LeftPos > Object.Left AND SectionInfo(Index).TopPos <= Object.Top) Then
                    SectionInfo(Index+1).TopPos = SectionInfo(Index).TopPos
                    SectionInfo(Index+1).LeftPos = SectionInfo(Index).LeftPos
                    Index = Index - 1
                End If
                If(SectionInfo(Index).LeftPos > Object.Left AND SectionInfo(Index).TopPos <= Object.Top) Then
                    SectionInfo(Index+1).TopPos = SectionInfo(Index).TopPos
                    SectionInfo(Index+1).LeftPos = SectionInfo(Index).LeftPos
                    Index = Index - 1
                End If
            End If
            SectionInfo(Index+1).TopPos = Object.Top
            SectionInfo(Index+1).LeftPos = Object.Left
         Count = Count + 1

    For  x = 1 to Count
    print SectionInfo(x).Text, SectionInfo(x).leftpos, SectionInfo(x).TopPos
    next x
    print "------------"

      End If
   End ForAll
END SUB


PUBLIC SUB ThreeColumnSection()
   Dim     PackedVal        As Long,        _
           DgmPath            As String,    _
           MaxSpinnerVal    As Integer,    _
           MaxObjectCount    As Integer,    _
           MinObjectCount As Integer, _
           NumSections        As Integer, _
           Count                As Integer,    _
           DefaultButton    As Integer, _
           x                    As Integer, _
           NumToAdd            As Integer, _
            NumToDel            As Integer, _
            i                    As Integer, _
            Index                As Integer,    _
            MaxDeleteVal    As Integer, _
           Section            As DrawObject,    _
           Temp                As DrawObject,    _
           SectionInfo(Max3ColSections)    As SegmentStruct


   MaxObjectCount = Max3ColSections + 1
   MinObjectCount    = Min3ColSections + 1

   For x = 1 to Max3ColSections                             '// Init array of SegmentStruct's
        SectionInfo(x).LeftPos        = 0
        SectionInfo(x).TopPos         = 0
      SectionInfo(x).Text     = ""
   Next x

   Set Temp = CurrentPage.FindObject(SegmentDgmName)  '// find Section diagram
   Set Section = Temp.Replicate()                        '// take dgm out of pb to ungroup
   Temp.Cut                                            '// delete dgm in pb
    Selection.ClearSelection
   Section.Ungroup                                       '// ungroup dgm copied - not in pb

   If(Selection.SelectionCount < MinObjectCount OR Selection.SelectionCount > MaxObjectCount) Then
      MessageBox InvalidDiagram, 0, ErrorMsg
      EndScript
   End If                                                     '// Checking for invalid diagram

   SELECT CASE(Selection.SelectionCount)                  '// Find number of segments
       Case 7: NumSections = 6
       Case 10: NumSections = 9
       Case 13: NumSections = 12
       Case 16: NumSections = 15
       Case 19: NumSections = 18
   END SELECT

   If(NumSections = Max3ColSections) Then                  '// if max number of segments, default to delete
      DefaultButton = 1
   Else                                                        '// otherwise default to add
      DefaultButton = 0
   End If

   Count = 0
   ForAll Obj In Selection.SelectedObjects               '// finds text shapes and stores text
      If(Obj.isText) Then
            Index = Count
         If(Count <> 0)    Then
               While((Index > 0) AND (SectionInfo(Index).TopPos < Obj.Top))    '// find a SectionInfo on same level
                    SectionInfo(Index+1) = SectionInfo(Index)
                    Index = Index - 1
                Wend
                If(SectionInfo(Index).LeftPos > Obj.Left AND SectionInfo(Index).TopPos <= Obj.Top) Then
                    SectionInfo(Index+1) = SectionInfo(Index)                            '// set to correct column
                    Index = Index - 1
                End If
                If(SectionInfo(Index).LeftPos > Obj.Left AND SectionInfo(Index).TopPos <= Obj.Top) Then
                    SectionInfo(Index+1) = SectionInfo(Index)
                    Index = Index - 1
                End If
            End If
            SectionInfo(Index+1).TopPos = Obj.Top
            SectionInfo(Index+1).LeftPos = Obj.Left
            SectionInfo(Index+1).Text = Obj.Text
         Count = Count + 1

    For  x = 1 to Count
    print SectionInfo(x).Text, SectionInfo(x).leftpos, SectionInfo(x).TopPos
    next x
    print "------------"

      End If
   End ForAll

   Set Section = Selection.Group()

   If(Count > NumSections) Then                                        '//  if diagram has incorrect layout, too much text
      MESSAGEBOX InvalidDiagram, 0, ErrorMsg
   Else
      DgmPath = [Freelance].Preferences.TemplateDir + SectionDgmFileName

        If(NumSections = Max3ColSections) Then
            MaxSpinnerVal = (Max3ColSections/3) - 1
        Else
            MaxSpinnerVal = (NumSections/3)
        End If

print "Section Count = ",numsections
print "MaxSpinnerVal = ",maxspinnerval

        MaxDeleteVal = (NumSections/3) - 1
         PackedVal = CurrentDocument.RunDialog(1, SectionDlgTitle, DiagramNote, SectionAddQuestion, SectionDelQuestion, _
                                                DefaultButton, NULLSTR, NULLSTR, _
                                                "1", STR$(MaxSpinnerVal), 1, MaxDeleteVal)

      If((PackedVal AND BitField9) = BitField9) Then               '// User ok'd dlg
         If((PackedVal AND BitField8) <> BitField8) Then           '// ADD section
            NumToAdd = PackedVal AND BitFields0To7
            If((NumToAdd > 0) AND (NumToAdd <= 5)) Then
               If(NumSections = Max3ColSections) Then             '// too many Section, can't add
                  MESSAGEBOX AddError, 0, ErrorMsg
                   Section.PutIntoPlacementBlock(DgmPBID)             '// restore dgm in pb
                        Section.Name = SegmentDgmName                      '// so we can find it later
                Else                                                     '// add goal
                  Section.Cut                                       '// remove old dgm
                  Set Section = CurrentPage.CreateSymbol(DgmPath, (NumSections/3)+21)
                        Selection.ClearSelection
                  Section.Ungroup

                  Find3ColSection SectionInfo()                       '// Find coordinates for each section and sort

                        x = NumSections + 3                                        '// clear one more for a whole level
                        While(x > ((NumToAdd)*3)+3)
                            SectionInfo(x).Text = SectionInfo(x-3).Text
print SectionInfo(x).text
                            x = x - 1
                        Wend

                  SectionInfo((NumToAdd*3)+1).Text = ""             '// not necessary since not used, but just to be safe
                        SectionInfo((NumToAdd*3)+2).Text = ""
                        SectionInfo((NumToAdd*3)+3).Text = ""

                  For x = 1 TO ((NumToAdd)*3)                          '// re-insert old Section
                     Set Temp = SelectSegment(x, SectionInfo())
                            If(StrCompare(SectionInfo(x).Text, NULLSTR)) Then    '// Don't replace text if no text, to keep
                         Temp.Text = SectionInfo(x).Text                        '// prompt text
                            End If
                  Next x
                  For x = ((NumToAdd*3)+4) TO (NumSections+3)
                     Set Temp = SelectSegment(x, SectionInfo())
                            If(StrCompare(SectionInfo(x).Text, NULLSTR)) Then    '// Don't replace text if no text, to keep
                         Temp.Text = SectionInfo(x).Text                        '// prompt text
                            End If
                  Next x

                  set Section = Selection.Group()                   '// put pieces back together
                  Section.PutIntoPlacementBlock(DgmPBID)              '// assume pb has id of 101
                  Section.Name = SegmentDgmName                      '// so we can find it later
               End If
            End If
         Else                                                        '// delete segment
            NumToDel = PackedVal AND BitFields0To7
            If(NumSections = Min3ColSections) Then
               MESSAGEBOX DeleteError, 0, ErrorMsg
               Section.PutIntoPlacementBlock(DgmPBID)                '// restore segment in pb
                    Section.Name = SegmentDgmName                         '// so we can find it later
            ElseIf ((NumToDel <= NumSections) AND (NumToDel > 0)) Then
               Section.Cut
               Set Section = CurrentPage.CreateSymbol(DgmPath, (NumSections/3)+19)
                    Selection.ClearSelection
               Section.Ungroup

               Find3ColSection SectionInfo()                             '// Find coordinates for each section and sort

               For x = ((NumToDel*3)+1) TO (NumSections-3)          '// delete segment in array of Sectiontruct's
                  SectionInfo(x).Text = SectionInfo(x+3).Text
               Next x

               SectionInfo(NumSections-1).Text = ""
               SectionInfo(NumSections-1).Text = ""
               SectionInfo(NumSections).Text = ""                    '// clear last item in array

               For x = 1 TO (NumSections-3)                            '// re-insert old Section
                  Set Temp = SelectSegment(x, SectionInfo())
                        If(StrCompare(SectionInfo(x).Text, NULLSTR)) Then    '// Don't replace text if no text, to keep
                      Temp.Text = SectionInfo(x).Text                        '// prompt text
                        End If
               Next x

               Set Section = Selection.Group()                       '// put pieces back together
               Section.PutIntoPlacementBlock(DgmPBID)
               Section.Name = SegmentDgmName                      '// so we can find later
            End If
         End If
      Else
         Section.PutIntoPlacementBlock(DgmPBID)                        '// user canceled out of dlg
            Section.Name = SegmentDgmName                                '// restore dgm in pb
      End If
      Selection.ClearSelection
   End If
END SUB