home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form Form1
- Appearance = 0 'Flat
- BackColor = &H00C0C0C0&
- BorderStyle = 1 'Fixed Single
- Caption = "Nudge"
- ClientHeight = 1395
- ClientLeft = 1380
- ClientTop = 2250
- ClientWidth = 1560
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 0
- weight = 700
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- ForeColor = &H80000008&
- Height = 1800
- Icon = "NUDGE.frx":0000
- Left = 1320
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 1395
- ScaleWidth = 1560
- Top = 1905
- Width = 1680
- Begin VB.CommandButton cmdTop
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "U"
- Height = 360
- Left = 600
- TabIndex = 3
- Top = 120
- Width = 360
- End
- Begin VB.CommandButton cmdDown
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "D"
- Height = 360
- Left = 600
- TabIndex = 2
- Top = 840
- Width = 360
- End
- Begin VB.CommandButton cmdRight
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "R"
- Height = 360
- Left = 960
- TabIndex = 1
- Top = 480
- Width = 360
- End
- Begin VB.CommandButton cmdLeft
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "L"
- Height = 360
- Left = 240
- TabIndex = 0
- Top = 480
- Width = 360
- End
- Attribute VB_Name = "Form1"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- ' -----------------------------------------------------------------------------
- ' Copyright (C) 1996 Visio Corporation. All rights reserved.
- ' You have a royalty-free right to use, modify, reproduce and distribute
- ' the Sample Application Files (and/or any modified version) in any way
- ' you find useful, provided that you agree that Visio has no warranty,
- ' obligations or liability for any Sample Application Files.
- ' -----------------------------------------------------------------------------
- Option Explicit
- Dim m_bDown As Integer
- Private Sub cmdDown_Click()
- Nudge 0, -1
- End Sub
- Private Sub cmdDown_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- m_bDown = True
- End Sub
- Private Sub cmdDown_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
- m_bDown = False
- End Sub
- Private Sub cmdLeft_Click()
- Nudge -1, 0
- End Sub
- Private Sub cmdLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- m_bDown = True
- End Sub
- Private Sub cmdLeft_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
- m_bDown = False
- End Sub
- Private Sub cmdRight_Click()
- Nudge 1, 0
- End Sub
- Private Sub cmdRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- m_bDown = True
- End Sub
- Private Sub cmdRight_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
- m_bDown = False
- End Sub
- Private Sub cmdTop_Click()
- Nudge 0, 1
- End Sub
- Private Sub cmdTop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- m_bDown = True
- End Sub
- Private Sub cmdTop_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
- m_bDown = False
- End Sub
- Private Sub Nudge(dX As Double, dY As Double)
- 'Call Nudge as follows:
- 'Nudge 0, -1 Move down one unit
- 'Nudge -1, 0 Move left one unit
- 'Nudge 1, 0 Move right one unit
- 'Nudge 0, 1 Move up one unit
- On Error GoTo lblErr
- Dim appVisio As Visio.Application
- Dim selObj As Visio.Selection
- Dim shpObj As Visio.Shape
- Dim unit As Double
- Dim i As Integer
- ' Establish a base unit as one inch
- unit = 1
- Set appVisio = GetObject(, "visio.application")
- Set selObj = appVisio.ActiveWindow.Selection
- ' If the selection is empty, there's nothing to do.
- ' Otherwise, move each object in the selection by the value of unit
- For i = 1 To selObj.Count
- Set shpObj = selObj(i)
- Debug.Print "Nudging "; shpObj.Name; " ("; shpObj.NameID; ")"
- If (Not shpObj.OneD) Then
- shpObj.Cells("PinX").ResultIU = (dX * unit) + shpObj.Cells("PinX").ResultIU
- shpObj.Cells("PinY").ResultIU = (dY * unit) + shpObj.Cells("PinY").ResultIU
- Else
- shpObj.Cells("BeginX").ResultIU = (dX * unit) + shpObj.Cells("BeginX").ResultIU
- shpObj.Cells("BeginY").ResultIU = (dY * unit) + shpObj.Cells("BeginY").ResultIU
- shpObj.Cells("EndX").ResultIU = (dX * unit) + shpObj.Cells("EndX").ResultIU
- shpObj.Cells("EndY").ResultIU = (dY * unit) + shpObj.Cells("EndY").ResultIU
- End If
- Next i
- lblErr:
- Exit Sub
- End Sub
-