code mouse pointer to select a dynamic connector end

A

andrewLLL

Can anybody tell how to put the mouse pointer on one end of
the connector and ready to drag (to change its shape)? It
is very easy to do it manually by hand, but how to code to
automatically do it?


Andrew
 
J

junethesecond

It seems Visio has no mouse pointer object.
But, you could move one end of connector
directly by putting x & y values to the cells,
EndX and EndY.
For Example.....
Public Sub myAnimation()
Dim x As Double, y As Double
Dim dx As Double, dy As Double
Dim I As Long, N As Long

x = 2#: y = 1#
dx = 0.1: dy = 0.3
N = 30
For I = 1 To N
x = x + dx: y = y + dy
MoveEndPointTo x, y
Delay
Next
End Sub

Private Sub MoveEndPointTo(x As Double, y As Double)
Dim con As Visio.Shape
Set con = ActivePage.Shapes("myConnector")
con.Cells("EndX") = x
con.Cells("Endy") = y
End Sub

Private Sub Delay()
Dim I As Long
For I = 1 To 10000
DoEvents
Next
End Sub
 
J

junethesecond

There is an example to animate
mouse icon on Visio.

Option Explicit
Private CountMouse As Long
Private WithEvents myApplication As Visio.Application

Private Declare Function SetCursorPos Lib "user32" _
(ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Sub mouse_event Lib "user32" _
(ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type PointsWin
nX1 As Long
nY1 As Long
nX2 As Long
nY2 As Long
End Type
Private Type PointsView
ax1 As Double
ay1 As Double
ax2 As Double
ay2 As Double
End Type
Private w As PointsWin
Private v As PointsView
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
Dim r As RECT
Dim p As POINTAPI
Dim tx As Double
Dim ty As Double
Dim sx As Double
Dim sy As Double
Dim I As Long, N As Long
Dim shp As Visio.Shape
If CountMouse < 2 Then
MsgBox "Click two different points, and _
press [START] again."
ActiveWindow.Activate
Exit Sub
End If
Form1.Hide
ActiveWindow.DeselectAll
GetCursorPos p
GetEndPoint tx, ty
N = 100
sx = (tx - p.X) / N
sy = (ty - p.Y) / N
For I = 1 To N
SetCursorPos p.X + sx * I, p.Y + sy * I
Sleep 10
Next I
mouse_event MOUSEEVENTF_LEFTDOWN, tx, ty, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, tx, ty, 0, 0
Sleep 1000
mouse_event MOUSEEVENTF_LEFTDOWN, tx, ty, 0, 0
For I = 1 To 100
SetCursorPos tx + I * 0.5, ty - I
Sleep 5
Next I
mouse_event MOUSEEVENTF_LEFTUP, _
tx + I * 0.5, ty - I, 0, 0
Form1.Show vbModeless
End Sub
Private Sub myApplication_MouseDown _
(ByVal Button As Long, ByVal KeyButtonState As Long, _
ByVal X As Double, ByVal Y As Double, _
CancelDefault As Boolean)
Dim p As POINTAPI
CountMouse = CountMouse + 1
GetCursorPos p
If CountMouse = 1 Then
w.nX1 = p.X: w.nY1 = p.Y
v.ax1 = X: v.ay1 = Y
ElseIf CountMouse = 2 Then
w.nX2 = p.X: w.nY2 = p.Y
v.ax2 = X: v.ay2 = Y
End If
End Sub
Private Sub UserForm_Activate()
Set myApplication = Visio.Application
ActiveWindow.Activate
End Sub
Private Sub GetEndPoint(dblX As Double, dblY As Double)
Dim X As Double, Y As Double
Dim con As Visio.Shape
Dim pnLeft As Long, pnTop As Long, _
pnWidth As Long, pnHeight As Long
Dim pdLeft As Double, pdTop As Double, _
pdWidth As Double, pdHeight As Double
ActiveWindow.GetWindowRect pnLeft, pnTop, _
pnWidth, pnHeight
ActiveWindow.GetViewRect pdLeft, pdTop, _
pdWidth, pdHeight
Set con = ActivePage.Shapes("myConnector")
X = con.Cells("EndX")
Y = con.Cells("EndY")
On Error GoTo ERRMSG
dblX = ((w.nX2 - w.nX1) / _
(v.ax2 - v.ax1)) * X + _
((w.nX1 * v.ax2 - w.nX2 * v.ax1) / _
(v.ax2 - v.ax1))
dblY = ((w.nY2 - w.nY1) / (v.ay2 - v.ay1)) _
* Y + ((w.nY1 * v.ay2 - w.nY2 * .ay1) _
/ (v.ay2 - v.ay1))
Exit Sub
ERRMSG:
MsgBox Err.Description & vbCr & _
" At first, click two different points, _
then press [START]."
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top