'This program optionally
'a) aligns all objects on the active page according to user-defined number
'   of rows and columns and
'   mark-up table by user request. Places resulting table on the 
'   new page.
'b) creates an empty table on the active page which contains or not any objects.
 

''''''''''''''''''''''''
Function Main As String
''''''''''''''''''''''''
Dim NRow, NCol, NObj,i As Integer
Dim Form As Object
Dim MarkUp As String

  Main="Completed."
  NObj=ActiveDocument.ActivePage.Drawings.Count
  If NObj=0 Then 
     Form = ReadFormFromLib("Tabwiz.frl", "Table Wizard - Creation of Empty Table")
     Form.SetStrValue("Remark","          There are no objects on your page.")
     Form.SetStrValue("MoreRemark","      You may create an empty table if you like.")
     'Display form
     If Form.ExecForm Then
          NRow=Form.GetIntValue("Rows")
          NCol=Form.GetIntValue("Columns")
     Else 
          Main="Cancelled."
          Exit Function
     End If
     Main = CreateEmptyTable(NRow,NCol)
  Else
     Form = ReadFormFromLib("Tabwiz.frl", "Table Wizard - Aligning Objects")
     Form.SetStrValue("Remark","      There are "+Str(NObj)+" objects on your page.")
     Form.SetStrValue("MoreRemark","       You may align them if you like.")
     'Display form
     If Form.ExecForm Then
          NRow=Form.GetIntValue("Rows")
          NCol=Form.GetIntValue("Columns")
          MarkUp=Form.GetStrValue("MarkUp")
          Call AlignTo(NObj,NRow,NCol,MarkUp)
     Else
          Main="Completed." 
          Exit Function
     End If
  End If

End Function


'''''''''''''''''''''''''''''''''''
Sub AlignTo (byval NObj As Integer,NRow As Integer,NCol As Integer, MarkUp As String)
'''''''''''''''''''''''''''''''''''
'This procedure enables If user's active page contains objects (not empty)
'Alligns objects according to user-defined number of rows and columns and Then
'mark-ups table by the user request

Dim pn,f,a,i,t,l,w,h,t1,l1,w1,h1,l2,t2,w2,h2,x,HMax,WMax,HRMax,WRMax,p As Integer
Dim MyObj, MyPage, MyHObj, MyWObj,MyLObj,MyTObj,MyPen As object
Dim MyDoc,APage,TemDoc,Rect As object
Dim name As String


'Adding new page and naming of active document
 MyDoc=ActiveDocument
 APage=ActiveDocument.ActivePage
 pn=MyDoc.Index(APage)
 MyPage=MyDoc.AddClone(pn)
 MyDoc.SetName("USER")

'Determining of max object's dimentions 
'Lets suppose that first object has max height... 
 MyHObj=MyPage.Drawings.Item(1)
 MyHObj.GetBound(l,t,w,h)

'...and Then find object with actually max height...
 For Each MyObj in MyPage.Drawings
   MyObj.GetBound(l1,t1,w1,h1)
    If h1>h Then 
      MyHObj=MyObj
      MyHObj.GetBound(l,t,w,h)
    End If
 Next MyObj

'...and set max height value.
 HMax=h

'Then lets suppose that MyHObject has max width...
 MyWObj=MyHObj

'...and Then find object with actually max width....
 For Each MyObj in MyPage.Drawings
   MyObj.GetBound(l1,t1,w1,h1)
    If w1>w Then 
      MyWObj=MyObj
      MyWObj.GetBound(l,t,w,h)
    End If
 Next MyObj

'...and set max width value.
 WMax=w


'Using finded values lets set table cell dimensions
 HRMax=HMax+Int(HMax/5)
 WRMax=WMax+Int(WMax/5) 

 
'Sorting the objects according to their positions on the page

 For f=1 to NRow 
'Find NCol top  objects
   For a=1 to NCol
     For Each MyObj in MyPage.Drawings
       name=MyObj.GetName
       If name="" Then
          MyTObj=MyObj
          Exit For
       End If
     Next MyObj
     MyTObj.GetBound(l,t,w,h)

     For Each MyObj in MyPage.Drawings
       name=MyObj.GetName
       If name="" Then
          MyObj.GetBound(l1,t1,w1,h1)
          If t1<=t Then 
             MyTObj=MyObj
             MyTObj.GetBound(l,t,w,h)
          End If
       End If
     Next MyObj

'Fix object with name
     MyTObj.SetName("FIXED"+Str(f))
   Next a

'Sorting objects in row according to left coordinate
   For a=1 to NCol
     For Each MyObj in MyPage.Drawings
       name=MyObj.GetName
       If name="FIXED"+Str(f) Then
          MyLObj=MyObj
          Exit For
       End If
     Next MyObj

     MyLObj.GetBound(l,t,w,h)

     For Each MyObj in MyPage.Drawings
       name=MyObj.GetName
       If name="FIXED"+Str(f) Then
          MyObj.GetBound(l1,t1,w1,h1)
          If l1<=l Then 
             MyLObj=MyObj
             MyLObj.GetBound(l,t,w,h)
          End If
       End If
     Next MyObj
     MyLObj.SetName("FIXED"+Str(f)+"x"+Str(a))

'if it is first (from cell 1x1) object Then store it's coordinates...
     name=MyLObj.GetName
     If name="FIXED1x1" Then
       MyLObj.GetBound(l2,t2,w2,h2)
       MyLObj.SetBound(l2,t2,w2,h2)
       GoTo Mark1 
     End If

'...If not Then place it 
     MyLObj.SetBound(Int(l2+w2/2+(4+WRMax)*(a-1)-w/2), Int(t2+h2/2-h/2+(4+HRMax)*(f-1)), w,h)
 
'...check If Next (not placed) object exist. If not Then finish aligning. 
     x=(f-1)*NCol+a
    If x=NObj Then GoTo Mark3
Mark1:
   Next a
 Next f

'Now ask user...
Mark3:
 If MarkUp="" Then Exit Sub
'find first object...
 For Each MyObj in MyPage.Drawings
    name=MyObj.GetName
    If name="FIXED1x1" Then 
       MyLObj=MyObj
       Exit For
    End If
 Next MyObj

'...and determine it's coordinates.
 MyLObj.GetBound(l,t,w,h)

'Open document with template cell...
 TemDoc=Documents.AddFromFile("tw_templ.sk2",FT_SKETCH)
'...and assing cell object
 Rect=TemDoc.ActivePage.Drawings.Item(1)

'Make user document active
 MyDoc.SetActiveDocument
 MyDoc.SetActivePage(MyPage)

'Placing cells
'In a loop...
 For f=1 to NRow
      For a=1 to NCol
          MyObj=Rect.LoadOnto(MyPage)
          MyPen=MyObj.GetPen
          p=MyPen.GetPenWidth
          MyObj.SetBound(Int(l+w/2-WRMax/2+(WRMax+2*p)*(a-1)), Int(t+h/2-HRMax/2+(HRMax+2*p)*(f-1)), WRMax, HRMax)
          MyObj.SetName("CELL"+Str(f)+"x"+Str(a))
      Next a
      For Each MyObj in MyPage.Drawings
          name=MyObj.GetName
          If name="CELL"+Str(f)+"x1" Then
              MyObj.GetBound(l2,t2,w2,h2)
              Exit For
              End If
      Next MyObj
      For Each MyObj in MyPage.Drawings
          name=MyObj.GetName
          If Left(name,5)="CELL"+Str(f) Then
              MyObj.GetBound(l1,t1,w1,h1)
              MyObj.SetBound(l1,t2,w2,h2)
          End If
      Next MyObj
 Next f

'Close template document
 Kill(TemDoc)

End Sub


''''''''''''''''''''
Function CreateEmptyTable(NRow As Integer, NCol As Integer) As String
''''''''''''''''''''
'This procedure enables If 
'1. Active page is empty or
'2. If user wish to create an empty table on the page containing objects.
'Creates table with user-defined number of rows and columns. 

Dim f,a,t,l,w,h,t1,l1,w1,h1,l2,t2,w2,h2,p,nd As Integer
Dim MyObj, MyPage, MyPen As object
Dim MyDoc,TemDoc,Rect, ResDoc As object
Dim name As String

 MyDoc=ActiveDocument
 MyPage=ActiveDocument.ActivePage
 MyDoc.SetName("USER")

 nd=Documents.Count
 If nd=1 Then ResDoc=Documents.AddEmpty
 TemDoc=Documents.AddFromFile("tw_templ.sk2",FT_SKETCH)
 If TemDoc = NULL Then
    If nd=1 Then Kill(ResDoc)
   CreateEmptyTable = "Error! Cannot find 'tw_templ.sk2' file."
   Exit Function
 End If

 Rect=TemDoc.ActivePage.Drawings.Item(1)
 Rect.GetBound(l,t,w,h)
 MyDoc.SetActiveDocument
 MyDoc.SetActivePage(MyPage)
 If nd=1 Then Kill(ResDoc)

'In a loop...
 For f=1 to NRow
    For a=1 to NCol
       MyObj=Rect.LoadOnto(MyPage)
       MyPen=MyObj.GetPen
    p=MyPen.GetPenWidth
    MyObj.SetBound(Int(l+(w+2*p)*(a-1)), Int(t+(h+2*p)*(f-1)), w, h)
    MyObj.SetName("CELL"+Str(f)+"x"+Str(a))
 Next a

 For Each MyObj in MyPage.Drawings
    name=MyObj.GetName
    If name="CELL"+Str(f)+"x1" Then
        MyObj.GetBound(l2,t2,w2,h2)
        Exit For
    End If
 Next MyObj
 For Each MyObj in MyPage.Drawings
    name=MyObj.GetName
    If Left(name,5)="CELL"+Str(f) Then
        MyObj.GetBound(l1,t1,w1,h1)
        MyObj.SetBound(l1,t2,w2,h2)
    End If
  Next MyObj

 Next f
 Kill(TemDoc)

 CreateEmptyTable = "Completed."

End Function
