Module ControlHandleText: missing ShapeUtils

Started by rfsl, November 16, 2015, 07:08:47 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

rfsl

Hi coders,

I'm a V user and I do some shapesheet stuff.

I got the guru code below from Experts-Exchage to help me add txt control to shapes missing it.
But if fails me miserably with "Variable not Found - ShapeUtils"!

All help is welcome :)

Option Explicit

'// Module: ControlHandleText
'//
'// Last Edit: 2010.05.17
'//
'// Procedures for adding the default control-handle-positioned
'// text to a selection of shape.
'//
'// Includes the SETREF behavior to handle users moving the text
'// block using the Text Block Tool, and hiding the control handle
'// when the shape has no text or HideText is true.

Private Const TextChCellName$ = "Controls.vgRepositionText"
Private Const TextChRowName$ = "vgRepositionText"

Private Const DefTextPosX_Left% = 0
Private Const DefTextPosX_Center% = 1
Private Const DefTextPosX_Right% = 2

Private Const DefTextPosY_Bottom% = 0
Private Const DefTextPosY_Middle% = 1
Private Const DefTextPosY_Top% = 2

'// Bottom-left:
Sub AddTextRepositionControlHandleToSelection_BottomLeft()
    Call m_iterateSelection(DefTextPosX_Left, DefTextPosY_Bottom)
End Sub
'// Bottom-center:
Sub AddTextRepositionControlHandleToSelection_CenterBottom()
    Call m_iterateSelection(DefTextPosX_Center, DefTextPosY_Bottom)
End Sub
'// Bottom-right:
Sub AddTextRepositionControlHandleToSelection_RightBottom()
    Call m_iterateSelection(DefTextPosX_Right, DefTextPosY_Bottom)
End Sub
'// Middle-left:
Sub AddTextRepositionControlHandleToSelection_LeftMiddle()
    Call m_iterateSelection(DefTextPosX_Left, DefTextPosY_Middle)
End Sub
'// Middle-right:
Sub AddTextRepositionControlHandleToSelection_RightMiddle()
    Call m_iterateSelection(DefTextPosX_Right, DefTextPosY_Middle)
End Sub
'// Top-left:
Sub AddTextRepositionControlHandleToSelection_TopLeft()
    Call m_iterateSelection(DefTextPosX_Left, DefTextPosY_Top)
End Sub
'// Top-right:
Sub AddTextRepositionControlHandleToSelection_TopRight()
    Call m_iterateSelection(DefTextPosX_Right, DefTextPosY_Top)
End Sub
'// Middle-center:
Sub AddTextRepositionControlHandleToSelection_CenterMiddle()
    Call m_iterateSelection(DefTextPosX_Center, DefTextPosY_Middle)
End Sub


Sub AddResetTextPositionAction()

  Const ResetTextActionLabel$ = "Reset Text Position"
  Const ResetTextActionRowName$ = "vgResetTextCH"
 
  Dim shp As Visio.Shape
  Dim r As Visio.Row
  Dim fDefaultX As String, fDefaultY As String
  For Each shp In Visio.ActiveWindow.Selection
 
    If (shp.CellExists(TextChCellName, Visio.VisExistsFlags.visExistsAnywhere)) Then
     
      Set r = ShapeUtils.GetOrAddActionRow(shp, ResetTextActionLabel, ResetTextActionRowName)
     
      fDefaultX = shp.Cells(TextChCellName).Formula
      fDefaultY = shp.Cells(TextChCellName & ".Y").Formula
     
      r(Visio.VisCellIndices.visActionMenu).Formula = Chr(34) & ResetTextActionLabel$ & Chr(34)
      r(Visio.VisCellIndices.visActionDisabled).Formula = _
        "AND((" & fDefaultX & ")=" & TextChCellName & ",(" & fDefaultY & ")=" & TextChCellName & ".Y)"
      r(Visio.VisCellIndices.visActionAction).Formula = "SETF(GETREF(" & TextChCellName & ")," & _
        Chr(34) & fDefaultX & Chr(34) & ")+SETF(GETREF(" & TextChCellName & ".Y)," & Chr(34) & fDefaultY & Chr(34) & ")"
       
      r(Visio.VisCellIndices.visActionSortKey).Formula = Chr(34) & "CheckState200" & Chr(34)
      r(Visio.VisCellIndices.visActionBeginGroup).ResultIU = 1
             
    End If
       
  Next shp
 
End Sub

Private Sub m_iterateSelection(ByVal defaultXpos As Integer, _
                               ByVal defaultYpos As Integer)

    Dim shp As Visio.Shape
    For Each shp In Visio.ActiveWindow.Selection
     
      Call m_addControlHandleText(shp, defaultXpos, defaultYpos)

    Next shp
   
End Sub
Private Sub m_addControlHandleText(ByRef shp As Visio.Shape, _
                                   ByVal defaultXpos As Integer, _
                                   ByVal defaultYpos As Integer)
 
  Dim visRow As Visio.Row
  Set visRow = ShapeUtils.GetOrAddControlHandleRow(shp, TextChRowName$)
 
   
  shp.Cells("TxtWidth").FormulaForceU = "GUARD(TEXTWIDTH(TheText))"
  shp.Cells("TxtHeight").FormulaForceU = "GUARD(TEXTHEIGHT(TheText,TxtWidth))"
  shp.Cells("TxtPinX").FormulaForceU = "SETATREF(" & TextChCellName & ".X)"
  shp.Cells("TxtPinY").FormulaForceU = "SETATREF(" & TextChCellName & ".Y)"
  shp.Cells("TxtLocPinX").FormulaForceU = "GUARD(TxtWidth*0.5)"
  shp.Cells("TxtLocPinY").FormulaForceU = "GUARD(TxtHeight*0.5)"
 
  Dim c As Visio.Cell
   
  Set c = visRow(Visio.VisCellIndices.visCtlX)
  Select Case defaultXpos
  Case 0
    c.FormulaForce = "-TxtWidth*0.5"
  Case 1
    c.FormulaForce = "Width*0.5"
  Case 2
    c.FormulaForce = "Width + TxtWidth*0.5"
  End Select
 
  Set c = visRow(Visio.VisCellIndices.visCtlY)
  Select Case defaultYpos
  Case 0
    c.FormulaForce = "-TxtHeight*0.5"
  Case 1
    c.FormulaForce = "Height*0.5"
  Case 2
    c.FormulaForce = "Height + TxtHeight*0.5"
  End Select
 
  Set c = visRow(Visio.VisCellIndices.visCtlTip)
  c.FormulaForce = Chr(34) & "Reposition Text" & Chr(34)
 
  Set c = visRow(Visio.VisCellIndices.visCtlGlue)
  c.FormulaForce = "FALSE"
 
  Set c = visRow(Visio.VisCellIndices.visCtlXCon)
  c.FormulaForce = "5*OR(HideText,STRSAME(SHAPETEXT(TheText)," & Chr(34) & Chr(34) & "))"
 
End Sub



Browser ID: smf (is_webkit)
Templates: 4: index (default), Display (default), GenericControls (default), GenericControls (default).
Sub templates: 6: init, html_above, body_above, main, body_below, html_below.
Language files: 4: index+Modifications.english (default), Post.english (default), Editor.english (default), Drafts.english (default).
Style sheets: 4: index.css, attachments.css, jquery.sceditor.css, responsive.css.
Hooks called: 130 (show)
Files included: 34 - 1321KB. (show)
Memory used: 1059KB.
Tokens: post-login.
Cache hits: 14: 0.00229s for 26,582 bytes (show)
Cache misses: 3: (show)
Queries used: 16.

[Show Queries]