home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 November / pcwk_11_98a.iso / Wtestowe / Vistdtk / Install / Data.Z / Nudge.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-11-04  |  5.4 KB  |  153 lines

  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "Nudge"
  7.    ClientHeight    =   1395
  8.    ClientLeft      =   1380
  9.    ClientTop       =   2250
  10.    ClientWidth     =   1560
  11.    BeginProperty Font 
  12.       name            =   "MS Sans Serif"
  13.       charset         =   0
  14.       weight          =   700
  15.       size            =   8.25
  16.       underline       =   0   'False
  17.       italic          =   0   'False
  18.       strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H80000008&
  21.    Height          =   1800
  22.    Icon            =   "NUDGE.frx":0000
  23.    Left            =   1320
  24.    LinkTopic       =   "Form1"
  25.    MaxButton       =   0   'False
  26.    MinButton       =   0   'False
  27.    ScaleHeight     =   1395
  28.    ScaleWidth      =   1560
  29.    Top             =   1905
  30.    Width           =   1680
  31.    Begin VB.CommandButton cmdTop 
  32.       Appearance      =   0  'Flat
  33.       BackColor       =   &H80000005&
  34.       Caption         =   "U"
  35.       Height          =   360
  36.       Left            =   600
  37.       TabIndex        =   3
  38.       Top             =   120
  39.       Width           =   360
  40.    End
  41.    Begin VB.CommandButton cmdDown 
  42.       Appearance      =   0  'Flat
  43.       BackColor       =   &H80000005&
  44.       Caption         =   "D"
  45.       Height          =   360
  46.       Left            =   600
  47.       TabIndex        =   2
  48.       Top             =   840
  49.       Width           =   360
  50.    End
  51.    Begin VB.CommandButton cmdRight 
  52.       Appearance      =   0  'Flat
  53.       BackColor       =   &H80000005&
  54.       Caption         =   "R"
  55.       Height          =   360
  56.       Left            =   960
  57.       TabIndex        =   1
  58.       Top             =   480
  59.       Width           =   360
  60.    End
  61.    Begin VB.CommandButton cmdLeft 
  62.       Appearance      =   0  'Flat
  63.       BackColor       =   &H80000005&
  64.       Caption         =   "L"
  65.       Height          =   360
  66.       Left            =   240
  67.       TabIndex        =   0
  68.       Top             =   480
  69.       Width           =   360
  70.    End
  71. Attribute VB_Name = "Form1"
  72. Attribute VB_Creatable = False
  73. Attribute VB_Exposed = False
  74. ' -----------------------------------------------------------------------------
  75. ' Copyright (C) 1996 Visio Corporation. All rights reserved.
  76. ' You have a royalty-free right to use, modify, reproduce and distribute
  77. ' the Sample Application Files (and/or any modified version) in any way
  78. ' you find useful, provided that you agree that Visio has no warranty,
  79. ' obligations or liability for any Sample Application Files.
  80. ' -----------------------------------------------------------------------------
  81. Option Explicit
  82. Dim m_bDown As Integer
  83. Private Sub cmdDown_Click()
  84.     Nudge 0, -1
  85. End Sub
  86. Private Sub cmdDown_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  87.     m_bDown = True
  88. End Sub
  89. Private Sub cmdDown_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  90.     m_bDown = False
  91. End Sub
  92. Private Sub cmdLeft_Click()
  93.     Nudge -1, 0
  94. End Sub
  95. Private Sub cmdLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  96.     m_bDown = True
  97. End Sub
  98. Private Sub cmdLeft_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  99.     m_bDown = False
  100. End Sub
  101. Private Sub cmdRight_Click()
  102.     Nudge 1, 0
  103. End Sub
  104. Private Sub cmdRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  105.     m_bDown = True
  106. End Sub
  107. Private Sub cmdRight_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  108.     m_bDown = False
  109. End Sub
  110. Private Sub cmdTop_Click()
  111.     Nudge 0, 1
  112. End Sub
  113. Private Sub cmdTop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  114.     m_bDown = True
  115. End Sub
  116. Private Sub cmdTop_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  117.     m_bDown = False
  118. End Sub
  119. Private Sub Nudge(dX As Double, dY As Double)
  120. 'Call Nudge as follows:
  121. 'Nudge 0, -1    Move down one unit
  122. 'Nudge -1, 0    Move left one unit
  123. 'Nudge 1, 0     Move right one unit
  124. 'Nudge 0, 1     Move up one unit
  125.     On Error GoTo lblErr
  126.     Dim appVisio As Visio.Application
  127.     Dim selObj As Visio.Selection
  128.     Dim shpObj As Visio.Shape
  129.     Dim unit As Double
  130.     Dim i As Integer
  131.     ' Establish a base unit as one inch
  132.     unit = 1
  133.     Set appVisio = GetObject(, "visio.application")
  134.     Set selObj = appVisio.ActiveWindow.Selection
  135.     ' If the selection is empty, there's nothing to do.
  136.     ' Otherwise, move each object in the selection by the value of unit
  137.     For i = 1 To selObj.Count
  138.         Set shpObj = selObj(i)
  139.         Debug.Print "Nudging "; shpObj.Name; " ("; shpObj.NameID; ")"
  140.         If (Not shpObj.OneD) Then
  141.             shpObj.Cells("PinX").ResultIU = (dX * unit) + shpObj.Cells("PinX").ResultIU
  142.             shpObj.Cells("PinY").ResultIU = (dY * unit) + shpObj.Cells("PinY").ResultIU
  143.         Else
  144.             shpObj.Cells("BeginX").ResultIU = (dX * unit) + shpObj.Cells("BeginX").ResultIU
  145.             shpObj.Cells("BeginY").ResultIU = (dY * unit) + shpObj.Cells("BeginY").ResultIU
  146.             shpObj.Cells("EndX").ResultIU = (dX * unit) + shpObj.Cells("EndX").ResultIU
  147.             shpObj.Cells("EndY").ResultIU = (dY * unit) + shpObj.Cells("EndY").ResultIU
  148.         End If
  149.     Next i
  150. lblErr:
  151.     Exit Sub
  152. End Sub
  153.