home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_1_94 / vbwin / visio / vissheet.bas < prev    next >
BASIC Source File  |  1993-10-26  |  29KB  |  821 lines
  1. '------------------------------------------------------------------------------
  2. '------------------------------------------------------------------------------
  3. '--
  4. '--                               Visio OLE Automation
  5. '--                              Shape Sheet "Wrappers"
  6. '--
  7. '--   File Name : vissheet.bas
  8. '--
  9. '-- Description : Contains high level interface to the four changeable shape
  10. '--               sheet sections (Geometry, Scratch, Control Point and
  11. '--               Connection Point).
  12. '--
  13. '-- Audit Trail:
  14. '--
  15. '--    When   | Who  | Description
  16. '-- ---------------------------------------------------------------------------
  17. '--  10/26/93 | TDS  | Saved in text format.
  18. '--   9/13/93 | TDS  | Updated for all VISCONST changes, added BestExportPoint.
  19. '--   8/27/93 | AW   | Updated some constants according to new object constants
  20. '--                  | in visConst.Bas.
  21. '--   7/21/93 | TDS  | Removed Get..Cell functions - Can't Use SET!
  22. '--   7/21/93 | TDS  | Added section delete procedure for control, connection
  23. '--                  | and scratch sections.
  24. '--   7/21/93 | TDS  | Allowed variant formulas to be passed for closed and
  25. '--                  | Hidden flag cells.
  26. '--   7/21/93 | TDS  | Added Set/GetStartPoint for geometry sections.
  27. '--   7/21/93 | TDS  | Changed Control Point references to Control Handle.
  28. '--   7/20/93 | TDS  | Added connection point procedures.
  29. '--   7/19/93 | TDS  | Debugged and tested control point and scratch wrappers.
  30. '--   7/19/93 | TDS  | Modified all procedures except Adds to only accept 1
  31. '--                    based indexes, i.e. no row constants.
  32. '--   7/16/93 | TDS  | Finished Scratch, Control and Connection wrappers.
  33. '--   7/15/93 | TDS  | Added Point Type & changed Delete/Set functions to Subs.
  34. '--                  | Began Implementation
  35. '--   7/14/93 | TDS  | Created
  36. '--
  37. '------------------------------------------------------------------------------
  38. '------------------------------------------------------------------------------
  39.  
  40. Option Explicit
  41.  
  42. '--
  43. '-- Type & Global Declarations
  44. '--
  45.  
  46. Global Const SIDE_TOP = 1
  47. Global Const SIDE_BOTTOM = 2
  48. Global Const SIDE_LEFT = 3
  49. Global Const SIDE_RIGHT = 4
  50.  
  51. Global Const visLineTo = 0
  52. Global Const visArcTo = 1
  53. Global Const visElArctTo = 2
  54.  
  55. Type VisPoint
  56.   X As Variant
  57.   Y As Variant
  58. End Type
  59.  
  60. Type CtrlHandle
  61.   X As Variant
  62.   Y As Variant
  63.   XDynamic As Variant
  64.   YDynamic As Variant
  65.   XBehavior As Variant
  66.   YBehavior As Variant
  67.   CanGlue As Variant
  68. End Type
  69.  
  70. Type ScratchRow
  71.   X As Variant
  72.   Y As Variant
  73.   A As Variant
  74.   B As Variant
  75.   C As Variant
  76.   D As Variant
  77. End Type
  78.  
  79. Type CnctPoint
  80.   X As Variant
  81.   Y As Variant
  82. End Type
  83.  
  84. Type Vertex
  85.   VtxType As Integer
  86.  
  87.   X As Variant
  88.   Y As Variant
  89.  
  90.   Bow As Variant
  91.  
  92.   XControlPoint As Variant
  93.   YControlPoint As Variant
  94.   Ecentricity As Variant
  95.   MajMinRatio As Variant
  96. End Type
  97.  
  98. Function AddCnctPoint (shp As Object, iPos As Integer) As Integer
  99. '-----------------------------------
  100. '--- AddCnctPoint ------------------
  101. '--
  102. '--   Use AddCnctPoint to add a new control point to a Shape object.
  103. '--
  104. '-- Parameters   : shp  - Visio Shape object to add row to.
  105. '--                iPos - 1 based index of new point (row) to be added.  Also
  106. '--                       accepts visRowLLast.
  107. '--
  108. '-- Return Value : 1 based index of point added if no error occurs.  Otherwise
  109. '--                visRowNone.
  110. '--
  111.  
  112.   Dim iRowIndex As Integer, iTemp As Integer
  113.   
  114.   If Not IsShape(shp) Or Not (iPos > 0 Or iPos = visRowLast) Then
  115.     AddCnctPoint = visRowNone
  116.     Exit Function
  117.   End If
  118.  
  119.   If iPos <> visRowLast Then                '-- Index Was Passed...
  120.     iRowIndex = visRowFirst + (iPos - 1)    '--   Convert To Row Index
  121.   Else                                      '-- Otherwise...
  122.     iRowIndex = visRowLast                  '--   Use Last Row
  123.   End If
  124.  
  125. '-- Next we add the row.  If all goes well iTemp should be the 0 based row
  126. '-- index added.  If visRowNone is not returned we add one to it to make the
  127. '-- 1 based index.
  128.  
  129.   iTemp = shp.AddRow(visSectionExport, iRowIndex, 0)
  130.  
  131.   If iTemp <> visRowNone Then iTemp = iTemp + 1
  132.  
  133.   AddCnctPoint = iTemp
  134. End Function
  135.  
  136. Function AddCtrlHandle (shp As Object, iPos As Integer) As Integer
  137. '-----------------------------------
  138. '--- AddCtrlHandle -----------------
  139. '--
  140. '--   Use AddCtrlHandle to add a new control handle to a Shape object.
  141. '--
  142. '-- Parameters   : shp  - Visio Shape object to add handle to.
  143. '--                iPos - 1 based index of handle (row) to be added.  Also
  144. '--                       accepts visRowLLast.
  145. '--
  146. '-- Return Value : 1 based index of handle added if no error occurs.  Otherwise
  147. '--                visRowNone.
  148. '--
  149.  
  150.   Dim iRowIndex As Integer, iTemp As Integer
  151.   
  152.   If Not IsShape(shp) Or Not (iPos > 0 Or iPos = visRowLast) Then
  153.     AddCtrlHandle = visRowNone
  154.     Exit Function
  155.   End If
  156.  
  157.   If iPos <> visRowLast Then                '-- Index Was Passed...
  158.     iRowIndex = visRowFirst + (iPos - 1)    '--   Convert To Row Index
  159.   Else                                      '-- Otherwise...
  160.     iRowIndex = visRowLast                  '--   Use Last Row
  161.   End If
  162.  
  163. '-- Next we add the row.  If all goes well iTemp should be the 0 based row
  164. '-- index added.  If visRowNone is not returned we just add one to the row
  165. '-- index and return it.
  166.  
  167.   iTemp = shp.AddRow(visSectionControls, iRowIndex, 0)
  168.  
  169.   If iTemp <> visRowNone Then iTemp = iTemp + 1
  170.  
  171.   AddCtrlHandle = iTemp
  172. End Function
  173.  
  174. Function AddGmtrySect (shp As Object, iSection As Integer) As Integer
  175. '-----------------------------------
  176. '--- AddGmtrySect ------------------
  177. '--
  178. '--   Adds a geometry section to a shape sheet using 1 based indexes.  If the
  179. '-- section index passed is larger than the section count the new section is
  180. '-- added at the end.
  181. '--
  182. '-- Parameters   : shp      - Visio Shape to add section to.
  183. '--                iSection - 1 based index of section to add.  If the section
  184. '--                           exists a blank one is inserted.  visSecLLast is
  185. '--                           a valid argument.
  186. '--
  187. '-- Return Value : visSecNone if an error occurs, otherwise the 1 based index
  188. '--                of the section added.
  189. '--
  190.  
  191.   Dim iSecIndex As Integer, iTemp As Integer
  192.  
  193.   AddGmtrySect = visSectionNone                 '-- Default To No Section Added
  194.  
  195.   If Not IsShape(shp) Or Not (iSection > 0 Or iSection = visSectionLastComponent) Then
  196.     Exit Function
  197.   End If
  198.  
  199.   If iSection <> visSectionLastComponent Then
  200.     iSecIndex = visSectionFirstComponent + (iSection - 1)
  201.   Else
  202.     iSecIndex = visSectionLastComponent
  203.   End If
  204. '--
  205. '--   Now we add the row.  On return, iTemp either has visSecNone if an error
  206. '-- occurred or the index of the section added.  If visSecNone we just exit
  207. '-- out.  Otherwise we use iTemp to add the property and Move To rows at the
  208. '-- beginning of the section.  Finally we return the 1 based sectio index.
  209. '--
  210.  
  211.   iTemp = shp.AddSection(iSecIndex)
  212.  
  213.   If iTemp <> visSectionNone Then
  214.     shp.AddRow iTemp, visRowFirst, visTagComponent
  215.     shp.AddRow iTemp, visRowFirst + 1, visTagMoveTo
  216.  
  217.     AddGmtrySect = iTemp + 1 - visSectionFirstComponent
  218.   End If
  219. End Function
  220.  
  221. Function AddScratchRow (shp As Object, iPos As Integer) As Integer
  222. '-----------------------------------
  223. '--- AddScratchRow -----------------
  224. '--
  225. '--   Adds a new scratch row to a Shape object.
  226. '--
  227. '-- Parameters   : shp  - Visio Shape object to add row to.
  228. '--                iPos - 1 based index of new row to be added.  Accepts
  229. '--                       visRowLLast.
  230. '--
  231. '-- Return Value : 1 based index of row added if no error occurs.  Otherwise
  232. '--                visRowNone.
  233. '--
  234.  
  235.   Dim iRowIndex As Integer, iTemp As Integer
  236.   
  237.   If Not IsShape(shp) Or Not (iPos > 0 Or iPos = visRowLast) Then
  238.     AddScratchRow = visRowNone
  239.     Exit Function
  240.   End If
  241.  
  242.   If iPos <> visRowLast Then               '-- Index Was Passed...
  243.     iRowIndex = visRowFirst + (iPos - 1)    '--   Convert To Row Index
  244.   Else                                      '-- Otherwise...
  245.     iRowIndex = visRowLast                 '--   Use Last Row
  246.   End If
  247.  
  248. '-- Next we add the row.  If all goes well iTemp should be the 0 based row
  249. '-- index added.  If it doesn't match with iRowIndex then an error occured
  250. '-- and we return the proper error code.
  251.  
  252.   iTemp = shp.AddRow(visSectionScratch, iRowIndex, 0)
  253.  
  254.   If iTemp <> visRowNone Then iTemp = iTemp + 1
  255.  
  256.   AddScratchRow = iTemp
  257. End Function
  258.  
  259. Function BestExportPoint (shp As Object, iSide As Integer) As Integer
  260. '-----------------------------------
  261. '--- BestExportPoint ---------------
  262. '--
  263. '--   Finds the best connection(export) point on a shape for any given side.
  264. '--
  265. '-- Return Value : 1 based index of best export point.
  266. '--
  267.  
  268.     Dim dMax As Double, dResult As Double, cell As Object
  269.     Dim iBest As Integer, iRow As Integer, iCol As Integer
  270.     Dim iRows As Integer
  271.  
  272.     If Not IsShape(shp) Then Exit Function
  273.  
  274.     iBest = 1
  275.     dMax = 0
  276.     iRows = shp.RowCount(visSectionExport)
  277.  
  278.     Select Case iSide
  279.         Case SIDE_LEFT, SIDE_RIGHT: iCol = 0
  280.         Case SIDE_TOP, SIDE_BOTTOM: iCol = 1
  281.     End Select
  282.  
  283.     For iRow = 0 To iRows
  284.         Set cell = shp.CellsSRC(visSectionExport, iRow, iCol)
  285.         dResult = cell.ResultIU
  286.         
  287.         Select Case iSide
  288.             Case SIDE_LEFT, SIDE_BOTTOM
  289.                 If dResult < dMax Then
  290.                     dMax = dResult
  291.                     iBest = iRow
  292.                 End If
  293.             Case SIDE_RIGHT, SIDE_TOP
  294.                 If dResult > dMax Then
  295.                     dMax = dResult
  296.                     iBest = iRow
  297.                 End If
  298.         End Select
  299.     Next iRow
  300.  
  301.     BestExportPoint = (iBest + 1)
  302. End Function
  303.  
  304. Sub DelConnectSection (shp As Object)
  305. '-----------------------------------
  306. '--- DelConnectSection -------------
  307. '--
  308. '--   Removes the Connection section from a shape sheet.  Use carefully!
  309. '--
  310. '-- Paremeters : shp - Shape sheet to remove connection section from.
  311. '--
  312.  
  313.   If IsShape(shp) Then shp.DeleteSection visSectionExport
  314. End Sub
  315.  
  316. Sub DeleteCnctPoint (shp As Object, iPos As Integer)
  317. '-----------------------------------
  318. '--- DeleteCnctPoint ---------------
  319. '--
  320. '--   Use DeleteCnctPoint to remove a connection point from a Shape object.
  321. '-- Offers 1 based row indexes and a safe method for deleting points.  Will not
  322. '-- remove the connection section if deleting the last row.  If the row index
  323. '-- passed does not exist then nothing is deleted.
  324. '--
  325. '-- Parameters   : shp  - Shape to delete point from.
  326. '--                iPos - 1 based index of point to be deleted.  Do NOT use
  327. '--                       row constants.
  328. '--
  329.  
  330.   If Not IsShape(shp) Or (iPos <= 0) Then Exit Sub
  331.  
  332.   shp.DeleteRow visSectionExport, visRowFirst + (iPos - 1)
  333. End Sub
  334.  
  335. Sub DeleteCtrlHandle (shp As Object, iPos As Integer)
  336. '-----------------------------------
  337. '--- DeleteCtrlHandle --------------
  338. '--
  339. '--   Use DeleteCtrlHandle to remove a control handle from a Shape object.
  340. '-- Offers 1 based row indexes and a safe method for deleting handles.  Will not
  341. '-- remove the controls section if deleting the last row.  If the row index
  342. '-- passed does not exist then nothing is deleted.
  343. '--
  344. '-- Parameters   : shp  - Shape to delete handle from.
  345. '--                iPos - 1 based index of handle to be deleted.  Do NOT use
  346. '--                       row constants.
  347. '--
  348.  
  349.   If Not IsShape(shp) Or (iPos <= 0) Then Exit Sub
  350.  
  351.   shp.DeleteRow visSectionControls, visRowFirst + (iPos - 1)
  352. End Sub
  353.  
  354. Sub DeleteScratchRow (shp As Object, iPos As Integer)
  355. '-----------------------------------
  356. '--- DeleteScratchRow --------------
  357. '--
  358. '--   Use DeleteScratchRow to remove a scratch row from a Shape object.
  359. '-- Offers 1 based row indexes and a safe method of deleting rows.  Will not
  360. '-- remove the scratch section if deleting the last row.  If the row index
  361. '-- passed does not exist then nothing is deleted.
  362. '--
  363. '-- Parameters   : shp  - Shape to delete row from.
  364. '--                iPos - 1 based index of row to be deleted.  Do NOT use
  365. '--                       row constants.
  366. '--
  367. '-- Return Value : None
  368. '--
  369.  
  370.   If Not IsShape(shp) Or (iPos <= 0) Then Exit Sub
  371.  
  372.   shp.DeleteRow visSectionScratch, visRowFirst + (iPos - 1)
  373. End Sub
  374.  
  375. Sub DelGmtrySect (shp As Object, iSection As Integer)
  376. '-----------------------------------
  377. '--- DelGmtrySect ------------------
  378. '--
  379. '--   Deletes a geometry section from a shape sheet.
  380. '--
  381. '-- Parameters : shp      - Shape object from which to delete the section.
  382. '--              iSection - 1 based index of section to delete.  If the section
  383. '--                         does not exists nothing is deleted.  visSecLLast
  384. '--                         is a valid argument.
  385. '--
  386.  
  387.   Dim iSecIndex As Integer
  388.  
  389.   If Not IsShape(shp) Or Not (iSection > 0 Or iSection = visSectionLastComponent) Then
  390.     Exit Sub
  391.   End If
  392.  
  393.   If iSecIndex <> visSectionLastComponent Then
  394.     iSecIndex = visSectionFirstComponent + (iSection - 1)
  395.   Else
  396.     iSecIndex = visSectionLastComponent
  397.   End If
  398.  
  399.   shp.DeleteSection iSecIndex
  400. End Sub
  401.  
  402. Sub DelHandleSection (shp As Object)
  403. '-----------------------------------
  404. '--- DelHandleSection --------------
  405. '--
  406. '--   Removes the Control handles section from a shape sheet.  Use carefully!
  407. '--
  408. '-- Paremeters : shp - Shape sheet to remove control handle section from.
  409. '--
  410.  
  411.   If IsShape(shp) Then shp.DeleteSection visSectionControls
  412. End Sub
  413.  
  414. Sub DelScratchSection (shp As Object)
  415. '-----------------------------------
  416. '--- DelScratchSection -------------
  417. '--
  418. '--   Removes the Scratch section from a shape sheet.  Use carefully!
  419. '--
  420. '-- Paremeters : shp - Shape sheet to remove Scratch section from.
  421. '--
  422.  
  423.   If IsShape(shp) Then shp.DeleteSection visSectionScratch
  424. End Sub
  425.  
  426. Function GetClosedFlag (shp As Object, iSection As Integer) As Variant
  427. '-----------------------------------
  428. '--- GetClosedFlag -----------------
  429. '--
  430. '--   Returns the Closed flag formula for a geometry section.
  431. '--
  432. '-- Parameters   : shp      - Shape sheet to act upon.
  433. '--                iSection - 1 based index of section to get Closed flag from.
  434. '--
  435. '-- Return Value : Variant containing the Closed flag formula.  Null if the
  436. '--                section doesn't exist.
  437. '--
  438.  
  439.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then
  440.     GetClosedFlag = Null
  441.     Exit Function
  442.   End If
  443.   
  444.   GetClosedFlag = shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 0, 0).Formula
  445. End Function
  446.  
  447. Sub GetCnctPoint (shp As Object, iPos As Integer, Pnt As CnctPoint)
  448. '-----------------------------------
  449. '--- GetCnctPoint ------------------
  450. '--
  451. '--   Retrieves a connection point structure from a shape.
  452. '--
  453. '-- Parameters   : shp  - Shape sheet to get point from.
  454. '--                iPos - 1 based index of point to retrieve.  Do NOT use
  455. '--                       row constants.
  456. '--                Pnt  - Structure to receive connect point's contents.
  457. '--
  458.  
  459.   Dim iRowIndex As Integer
  460.  
  461.   'If Not IsShape(shp) Then Exit Sub     'Called By TotalCnctPts!
  462.   If Not (iPos >= 1 And iPos <= TotalCnctPts(shp)) Then Exit Sub
  463.  
  464.   iRowIndex = visRowFirst + (iPos - 1)      '--   Convert Index
  465.  
  466.   Pnt.X = shp.CellsSRC(visSectionExport, iRowIndex, 0).Formula
  467.   Pnt.Y = shp.CellsSRC(visSectionExport, iRowIndex, 1).Formula
  468. End Sub
  469.  
  470. Sub GetCtrlHandle (shp As Object, iPos As Integer, Pnt As CtrlHandle)
  471. '-----------------------------------
  472. '--- GetCtrlHandle -----------------
  473. '--
  474. '--   Retrieves a control handle structure from a shape.
  475. '--
  476. '-- Parameters   : shp  - Shape sheet to get handle from.
  477. '--                iPos - 1 based index of handle to retrieve.  Do NOT use
  478. '--                       row constants.
  479. '--                Pnt  - Structure to receive control handle's contents.
  480. '--
  481.  
  482.   Dim iRowIndex As Integer
  483.  
  484.   'If Not IsShape(shp) Then Exit Sub     'Called By TotalCtrlPts!
  485.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  486.  
  487.   iRowIndex = visRowFirst + (iPos - 1)      '--   Convert Index
  488.  
  489.   Pnt.X = shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula
  490.   Pnt.Y = shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula
  491.   Pnt.XDynamic = shp.CellsSRC(visSectionControls, iRowIndex, 2).Formula
  492.   Pnt.YDynamic = shp.CellsSRC(visSectionControls, iRowIndex, 3).Formula
  493.   Pnt.XBehavior = shp.CellsSRC(visSectionControls, iRowIndex, 4).Formula
  494.   Pnt.YBehavior = shp.CellsSRC(visSectionControls, iRowIndex, 5).Formula
  495.   Pnt.CanGlue = shp.CellsSRC(visSectionControls, iRowIndex, 6).Formula
  496. End Sub
  497.  
  498. Sub GetCtrlHandlePt (shp As Object, iPos As Integer, Pnt As VisPoint)
  499. '-----------------------------------
  500. '--- GetCtrlHandle -----------------
  501. '--
  502. '--   Retrieves a control handle X,Y point structure from a shape.
  503. '--
  504. '-- Parameters   : shp  - Shape sheet to get handle from.
  505. '--                iPos - 1 based index of handle to retrieve.  Do NOT use
  506. '--                       row constants.
  507. '--                Pnt  - Structure to receive control handle's X,Y point.
  508. '--
  509.  
  510.   Dim iRowIndex As Integer
  511.  
  512.   'If Not IsShape(shp) Then Exit Sub     'Called By TotalCtrlPts!
  513.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  514.  
  515.   iRowIndex = visRowFirst + (iPos - 1)      '--   Convert Index
  516.  
  517.   Pnt.X = shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula
  518.   Pnt.Y = shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula
  519. End Sub
  520.  
  521. Function GetHiddenFlag (shp As Object, iSection As Integer) As Variant
  522. '-----------------------------------
  523. '--- GetHiddenFlag -----------------
  524. '--
  525. '--   Returns the Hidden flag formula for a given geometry section.
  526. '--
  527. '-- Parameters   : shp      - Shape sheet to act upon.
  528. '--                iSection - 1 based index of section to get Hidden flag from.
  529. '--
  530. '-- Return Value : Variant containing the Hidden flag formula.  Null if the
  531. '--                section doesn't exist.
  532. '--
  533.  
  534.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then
  535.     GetHiddenFlag = Null
  536.     Exit Function
  537.   End If
  538.  
  539.   GetHiddenFlag = shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 0, 2).Formula
  540. End Function
  541.  
  542. Sub GetScratchRow (shp As Object, iPos As Integer, Row As ScratchRow)
  543. '-----------------------------------
  544. '--- GetScratchRow -----------------
  545. '--
  546. '--   Retrieves a scratch row from a shape sheet.  If the row does not exist
  547. '-- then nothing is retrieved.
  548. '--
  549. '-- Parameters   : shp  - Shape sheet to get row from.
  550. '--                iPos - 1 based index of row to retrieve.  Do NOT use
  551. '--                       row constants.
  552. '--                Row  - Structure to receive the row's content.
  553. '--
  554.  
  555.   Dim iRowIndex As Integer
  556.  
  557.   'If Not IsShape(shp) Then Exit Sub  'Called By TotalScratchRows!
  558.   If Not (iPos >= 1 And iPos <= TotalScratchRows(shp)) Then Exit Sub
  559.  
  560.   iRowIndex = visRowFirst + (iPos - 1)
  561.  
  562.   Row.X = shp.CellsSRC(visSectionScratch, iRowIndex, 0).Formula
  563.   Row.Y = shp.CellsSRC(visSectionScratch, iRowIndex, 1).Formula
  564.   Row.A = shp.CellsSRC(visSectionScratch, iRowIndex, 2).Formula
  565.   Row.B = shp.CellsSRC(visSectionScratch, iRowIndex, 3).Formula
  566.   Row.C = shp.CellsSRC(visSectionScratch, iRowIndex, 4).Formula
  567.   Row.D = shp.CellsSRC(visSectionScratch, iRowIndex, 5).Formula
  568. End Sub
  569.  
  570. Sub GetStartPoint (shp As Object, iSection As Integer, Pnt As VisPoint)
  571. '-----------------------------------
  572. '--- GetStartPoint -----------------
  573. '--
  574. '--   Retrieves the start point row, AKA MoveTo row, from a shape sheet
  575. '-- geometry section.
  576. '--
  577. '-- Parameters : shp      - Shape sheet to act on.
  578. '--              iSection - 1 based index of geometry section.
  579. '--              Pnt      - VisPoint structure to receive point.
  580. '--
  581.  
  582.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then Exit Sub
  583.  
  584.   Pnt.X = shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 1, 0).Formula
  585.   Pnt.Y = shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 1, 1).Formula
  586. End Sub
  587.  
  588. Function GmtryCount (shp As Object) As Integer
  589. '-----------------------------------
  590. '--- GmtryCount --------------------
  591. '--
  592. '--   Returns the number of geometry sections in a shape sheet.
  593. '--
  594. '-- Parameters : shp - Shape to get geometry count from.
  595. '--
  596.  
  597.   If IsShape(shp) Then GmtryCount = shp.GeometryCount
  598. End Function
  599.  
  600. Function HandleCount (shp As Object) As Integer
  601. '-----------------------------------
  602. '--- HandleCount -------------------
  603. '--
  604. '--   Returns the total number of control handles in a shape sheet.  Zero is
  605. '-- returned even if shape is invalid.
  606. '--
  607.  
  608.   If IsShape(shp) Then
  609.     HandleCount = shp.RowCount(visSectionControls)
  610.   End If
  611. End Function
  612.  
  613. Function IsShape (shp As Object) As Integer
  614. '-----------------------------------
  615. '--- IsShape -----------------------
  616. '--
  617. '--   Returns a boolean indicating if shp is a shape object
  618. '--
  619.  
  620.   IsShape = Not (shp Is Nothing) And Not (shp.Dump(0) <> visShape)
  621. End Function
  622.  
  623. Sub SetClosedFlag (shp As Object, iSection As Integer, Flag As Variant)
  624. '-----------------------------------
  625. '--- SetClosedFlag -----------------
  626. '--
  627. '--   Changes the closed flag for a section.  No changes are made if the
  628. '-- section doesn't exist.
  629. '--
  630. '-- Parameters : shp      - Shape sheet on which to act.
  631. '--              iSection - 1 based index of geometry section to use.  Do NOT
  632. '--                         use section constats.
  633. '--               Flag    - New formula for closed flag cell.
  634. '--
  635.  
  636.   'IsShape is called indirectly by GmtryCount
  637.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then Exit Sub
  638.  
  639.   shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 0, 0).Formula = Flag
  640. End Sub
  641.  
  642. Sub SetCnctPoint (shp As Object, iPos As Integer, NewPoint As CnctPoint)
  643. '-----------------------------------
  644. '--- SetCnctPoint ------------------
  645. '--
  646. '--   Sets a connection point using a CnctPoint structure.  No changes are made
  647. '-- unless the point exists.
  648. '--
  649. '-- Parameters   : shp      - Shape sheet to get cell from.
  650. '--                iPos     - 1 based index of connection point to replace.
  651. '--                           Do NOT use row constants.
  652. '--                NewPoint - Contains new connection point contents.
  653. '--
  654.  
  655.   Dim iRowIndex As Integer
  656.  
  657.   'If Not IsShape(shp) Then Exit Sub 'Called By TotalCnctPts
  658.   If Not (iPos >= 1 And iPos <= TotalCnctPts(shp)) Then Exit Sub
  659.  
  660.   iRowIndex = visRowFirst + (iPos - 1)
  661.  
  662.   shp.CellsSRC(visSectionExport, iRowIndex, 0).Formula = NewPoint.X
  663.   shp.CellsSRC(visSectionExport, iRowIndex, 1).Formula = NewPoint.Y
  664. End Sub
  665.  
  666. Sub SetCtrlHandle (shp As Object, iPos As Integer, NewPoint As CtrlHandle)
  667. '-----------------------------------
  668. '--- SetCtrlHandle -----------------
  669. '--
  670. '--   Sets a control point using a CtrlHandle structure.  No changes are made
  671. '-- unless the point exists.
  672. '--
  673. '-- Parameters   : shp      - Shape sheet to get cell from.
  674. '--                iPos     - 1 based index of control point to replace.  Do not
  675. '--                           use row constants.
  676. '--                NewPoint - Contains new control handle contents.
  677. '--
  678.  
  679.   Dim iRowIndex As Integer
  680.  
  681.   'If Not IsShape(shp) Then Exit Sub 'Called By TotalCtrlPts
  682.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  683.  
  684.   iRowIndex = visRowFirst + (iPos - 1)
  685.  
  686.   shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula = NewPoint.X
  687.   shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula = NewPoint.Y
  688.   shp.CellsSRC(visSectionControls, iRowIndex, 2).Formula = NewPoint.XDynamic
  689.   shp.CellsSRC(visSectionControls, iRowIndex, 3).Formula = NewPoint.YDynamic
  690.   shp.CellsSRC(visSectionControls, iRowIndex, 4).Formula = NewPoint.XBehavior
  691.   shp.CellsSRC(visSectionControls, iRowIndex, 5).Formula = NewPoint.YBehavior
  692.   shp.CellsSRC(visSectionControls, iRowIndex, 6).Formula = NewPoint.CanGlue
  693. End Sub
  694.  
  695. Sub SetCtrlHandlePt (shp As Object, iPos As Integer, NewPoint As VisPoint)
  696. '-----------------------------------
  697. '--- SetCtrlHandlePt ---------------
  698. '--
  699. '--   Sets a control handles X,Y point only using a VisPoint structure.  No
  700. '-- changes are made unless the point exists.
  701. '--
  702. '-- Parameters   : shp      - Shape sheet to get cell from.
  703. '--                iPos     - 1 based index of control point to replace.  Do not
  704. '--                           use row constants.
  705. '--                NewPoint - Contains new control handle X,Y point.
  706. '--
  707.  
  708.   Dim iRowIndex As Integer
  709.  
  710.   'If Not IsShape(shp) Then Exit Sub 'Called By TotalCtrlPts
  711.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  712.  
  713.   iRowIndex = visRowFirst + (iPos - 1)
  714.  
  715.   shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula = NewPoint.X
  716.   shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula = NewPoint.Y
  717. End Sub
  718.  
  719. Sub SetHiddenFlag (shp As Object, iSection As Integer, Flag As Variant)
  720. '-----------------------------------
  721. '--- SetHiddenFlag -----------------
  722. '--
  723. '--   Changes the hidden flag for a section.  No changes are made if the
  724. '-- section doesn't exist.
  725. '--
  726. '-- Parameters : shp      - Shape sheet on which to act.
  727. '--              iSection - 1 based index of geometry section to use.  Do NOT
  728. '--                         use section constats.
  729. '--               Flag    - New formula for hidden flag cell.
  730. '--
  731.  
  732.   'IsShape is called indirectly by GmtryCount
  733.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then Exit Sub
  734.  
  735.   shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 0, 2).Formula = Flag
  736. End Sub
  737.  
  738. Sub SetScratchRow (shp As Object, iPos As Integer, NewRow As ScratchRow)
  739. '-----------------------------------
  740. '--- SetScratchRow -----------------
  741. '--
  742. '--   Set the contents of scratch rows using a ScratchRow structure.  No changes
  743. '-- are made if the row doesn't exist.
  744. '--
  745. '-- Parameters   : shp     - Shape sheet to get cell from.
  746. '--                iPos    - 1 based index of row to retrieve.
  747. '--                NewRow  - Contains new contents for the row.
  748.  
  749.   Dim iRowIndex As Integer
  750.  
  751.   'If Not IsShape(shp) Then Exit Sub  'Called By TotalScratchRows
  752.   If Not (iPos >= 1 And iPos <= TotalScratchRows(shp)) Then Exit Sub
  753.  
  754.   iRowIndex = visRowFirst + (iPos - 1)
  755.  
  756.   shp.CellsSRC(visSectionScratch, iRowIndex, 0).Formula = NewRow.X
  757.   shp.CellsSRC(visSectionScratch, iRowIndex, 1).Formula = NewRow.Y
  758.   shp.CellsSRC(visSectionScratch, iRowIndex, 2).Formula = NewRow.A
  759.   shp.CellsSRC(visSectionScratch, iRowIndex, 3).Formula = NewRow.B
  760.   shp.CellsSRC(visSectionScratch, iRowIndex, 4).Formula = NewRow.C
  761.   shp.CellsSRC(visSectionScratch, iRowIndex, 5).Formula = NewRow.D
  762. End Sub
  763.  
  764. Sub SetStartPoint (shp As Object, iSection As Integer, Pnt As VisPoint)
  765. '-----------------------------------
  766. '--- SetStartPoint -----------------
  767. '--
  768. '--   Sets the start point row, AKA MoveTo row, in a shape sheet geometry
  769. '-- section.
  770. '--
  771. '-- Parameters : shp      - Shape sheet to act on.
  772. '--              iSection - 1 based index of geometry section.
  773. '--              Pnt      - VisPoint structure containing new point.
  774. '--
  775.  
  776.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then Exit Sub
  777.  
  778.   shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 1, 0).Formula = Pnt.X
  779.   shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 1, 1).Formula = Pnt.Y
  780. End Sub
  781.  
  782. Function TotalCnctPts (shp As Object) As Integer
  783. '-----------------------------------
  784. '--- TotalCnctPts ------------------
  785. '--
  786. '--   Returns the total number of connection points in a shape sheet.  Zero is
  787. '-- returned even if the shape is invalid.
  788. '--
  789.  
  790.   If IsShape(shp) Then
  791.     TotalCnctPts = shp.RowCount(visSectionExport)
  792.   End If
  793. End Function
  794.  
  795. Function TotalScratchRows (shp As Object) As Integer
  796. '-----------------------------------
  797. '--- TotalScratchRows --------------
  798. '--
  799. '--   Returns the total number of scratch rows in a shape sheet.  Zero is
  800. '-- returned even if the shape is invalid.
  801. '--
  802.  
  803.   If IsShape(shp) Then
  804.     TotalScratchRows = shp.RowCount(visSectionScratch)
  805.   End If
  806. End Function
  807.  
  808. Function VertexCount (shp As Object, iSection As Integer) As Integer
  809. '-----------------------------------
  810. '--- VertexCount -------------------
  811. '--
  812. '--   Returns the number of verticies in a shape sheet geometry section.  This
  813. '-- count does not include the property row.
  814. '--
  815.  
  816.   If Not IsShape(shp) Then Exit Function
  817.  
  818.   VertexCount = shp.RowCount(visSectionFirstComponent + (iSection - 1)) - 1
  819. End Function
  820.  
  821.