在演示模式下单击另一个形状时,visio 中是否有办法 show/hide 一个形状?
Is there a way in visio to show/hide a shape when clicking on another shape in Presentation Mode?
我正在尝试使用 Visio 2016 做一个非常基本的用户界面线框。我想做一些事情,比如当我点击一个按钮时显示一个对话框,然后当我点击 "ok" 在对话框中。我之前一直通过完全复制整个页面并将我想要的内容添加到新页面并使用 "Hyperlink" 选项来完成此操作。如果有一种方法可以在我单击另一个形状时显示或隐藏一个形状,那就容易多了。有这样的能力吗?
在演示模式中?没有。Presentation Mode几乎没有交互。
您可以在全屏模式下获取一些代码 运行。我在下面的示例中挂钩了应用程序 MouseMove 事件。当鼠标悬停在该形状上时,它会使您过度胖的形状的轮廓。
您可以通过在页面上绘制一堆矩形,然后在全屏模式下移动鼠标来测试代码。
不过,我无法在全屏模式下捕获 MouseDown。
更多注释在代码注释中!
Option Explicit
'// Notes:
'//
'// - This code works in full screen mode!
'// - The mouse-up code doesn't work if you drag the shape,
'// (which won't be an issue in full-screen mode!)
Dim WithEvents m_visApp As Visio.Application
Private m_visShpMouseDown As Visio.Shape
Private m_lineWeightFormulaU As String
Private Sub Document_RunModeEntered(ByVal doc As IVDocument)
'// Toggle RunMode on and off via the blue triangle button just
'// right of the Stop/Reset button. This lets you reset the
'// code without closing and opening the file every time! Also,
'// this proc runs when you open the file, so m_visApp will
'// be set up to receive events!
Set m_visApp = Visio.Application
End Sub
Private Sub m_visApp_MouseMove(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)
Dim pg As Visio.Page
Set pg = m_visApp.ActivePage
If (pg Is Nothing) Then GoTo Cleanup
Dim shp As Visio.Shape
For Each shp In pg.Shapes
If (shp.HitTest(x, y, 0)) Then
'// The mouse is over a shape.
If (shp Is m_visShpMouseDown) Then
Debug.Print "MouseMove over same shape! " & DateTime.Now
GoTo Cleanup
Else
Debug.Print "MouseMove over shape! " & DateTime.Now
'// Restore any previously mouse-overed shape:
Call m_restoreShape
'// Save the original lineweight and change it to
'// something thicker:
m_lineWeightFormulaU = shp.CellsU("LineWeight").FormulaU
Set m_visShpMouseDown = shp
'// Make the lineweight thick:
shp.CellsU("LineWeight").FormulaForceU = "5pt"
GoTo Cleanup
'// Note: the above won't change the lineweights
'// for all shapes in a group. If you intend to use
'// this on grouped shapes, you'll have to recurse
'// into the group, which makes things a bit more
'// complicated!
End If
End If
Next shp
Call m_restoreShape
Cleanup:
Set shp = Nothing
Set pg = Nothing
End Sub
Private Sub m_restoreShape()
If (m_visShpMouseDown Is Nothing) Then Exit Sub
'// Restore the shape's original lineweight:
m_visShpMouseDown.CellsU("LineWeight").FormulaU = m_lineWeightFormulaU
'// Clear the mouse-down variables:
Set m_visShpMouseDown = Nothing
m_lineWeightFormulaU = vbNullString
End Sub
我正在尝试使用 Visio 2016 做一个非常基本的用户界面线框。我想做一些事情,比如当我点击一个按钮时显示一个对话框,然后当我点击 "ok" 在对话框中。我之前一直通过完全复制整个页面并将我想要的内容添加到新页面并使用 "Hyperlink" 选项来完成此操作。如果有一种方法可以在我单击另一个形状时显示或隐藏一个形状,那就容易多了。有这样的能力吗?
在演示模式中?没有。Presentation Mode几乎没有交互。
您可以在全屏模式下获取一些代码 运行。我在下面的示例中挂钩了应用程序 MouseMove 事件。当鼠标悬停在该形状上时,它会使您过度胖的形状的轮廓。
您可以通过在页面上绘制一堆矩形,然后在全屏模式下移动鼠标来测试代码。
不过,我无法在全屏模式下捕获 MouseDown。
更多注释在代码注释中!
Option Explicit
'// Notes:
'//
'// - This code works in full screen mode!
'// - The mouse-up code doesn't work if you drag the shape,
'// (which won't be an issue in full-screen mode!)
Dim WithEvents m_visApp As Visio.Application
Private m_visShpMouseDown As Visio.Shape
Private m_lineWeightFormulaU As String
Private Sub Document_RunModeEntered(ByVal doc As IVDocument)
'// Toggle RunMode on and off via the blue triangle button just
'// right of the Stop/Reset button. This lets you reset the
'// code without closing and opening the file every time! Also,
'// this proc runs when you open the file, so m_visApp will
'// be set up to receive events!
Set m_visApp = Visio.Application
End Sub
Private Sub m_visApp_MouseMove(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)
Dim pg As Visio.Page
Set pg = m_visApp.ActivePage
If (pg Is Nothing) Then GoTo Cleanup
Dim shp As Visio.Shape
For Each shp In pg.Shapes
If (shp.HitTest(x, y, 0)) Then
'// The mouse is over a shape.
If (shp Is m_visShpMouseDown) Then
Debug.Print "MouseMove over same shape! " & DateTime.Now
GoTo Cleanup
Else
Debug.Print "MouseMove over shape! " & DateTime.Now
'// Restore any previously mouse-overed shape:
Call m_restoreShape
'// Save the original lineweight and change it to
'// something thicker:
m_lineWeightFormulaU = shp.CellsU("LineWeight").FormulaU
Set m_visShpMouseDown = shp
'// Make the lineweight thick:
shp.CellsU("LineWeight").FormulaForceU = "5pt"
GoTo Cleanup
'// Note: the above won't change the lineweights
'// for all shapes in a group. If you intend to use
'// this on grouped shapes, you'll have to recurse
'// into the group, which makes things a bit more
'// complicated!
End If
End If
Next shp
Call m_restoreShape
Cleanup:
Set shp = Nothing
Set pg = Nothing
End Sub
Private Sub m_restoreShape()
If (m_visShpMouseDown Is Nothing) Then Exit Sub
'// Restore the shape's original lineweight:
m_visShpMouseDown.CellsU("LineWeight").FormulaU = m_lineWeightFormulaU
'// Clear the mouse-down variables:
Set m_visShpMouseDown = Nothing
m_lineWeightFormulaU = vbNullString
End Sub