home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1999 January / pcwk_01_1999.iso / Wtestowe / Vistdstd / Install / Data.Z / Helper.BAS < prev    next >
BASIC Source File  |  1996-09-04  |  6KB  |  200 lines
  1. Attribute VB_Name = "helper"
  2. ' -----------------------------------------------------------------------------
  3. ' Copyright (C) 1993-1996 Visio Corporation. All rights reserved.
  4. '
  5. ' You have a royalty-free right to use, modify, reproduce and distribute
  6. ' the Sample Application Files (and/or any modified version) in any way
  7. ' you find useful, provided that you agree that Visio has no warranty,
  8. ' obligations or liability for any Sample Application Files.
  9. ' -----------------------------------------------------------------------------
  10.  
  11. Option Explicit
  12.  
  13. '--
  14. '-- SetHourGlass action constants
  15. '--
  16.  
  17. Global Const MP_WAIT = 1
  18. Global Const MP_NORMAL = 2
  19. Global Const MP_RESTORE = 3
  20.  
  21. '--
  22. '-- Type & Global Declarations
  23. '--
  24.  
  25. Global Const SIDE_TOP = 1
  26. Global Const SIDE_BOTTOM = 2
  27. Global Const SIDE_LEFT = 3
  28. Global Const SIDE_RIGHT = 4
  29.  
  30. Type VisPoint
  31.   X As Variant
  32.   Y As Variant
  33. End Type
  34.  
  35.  
  36. Sub SetMousePointer(iType As Integer)
  37. '----------------------------------------
  38. '--- SetMousePointer --------------------
  39. '--
  40. '--   Manages multiple requests for the hour glass pointer.  Passing MP_WAIT
  41. '-- not only changes the pointer to an hourglass, it increments the count of
  42. '-- requests for it.  MP_NORMAL will decrement it and only when it returns
  43. '-- to zero does the cursor change back to it's default pointer.  Multiple
  44. '-- procedures can ask for an hourglass this way without overrunning each other.
  45. '--
  46. '-- Parameters : iType - MP_WAIT     Changes mouse pointer to hourglass if not
  47. '--                                  already.
  48. '--                      MP_NORMAL   Decrements the hourglass count and, if 0,
  49. '--                                  restores the pointer to it's default.
  50. '--                      MP_RESTORE  Clears the hourglass count and restores
  51. '--                                  the pointer to it's default.
  52. '--
  53.  
  54.     Static iWaitCount As Integer
  55.  
  56.     Select Case iType
  57.         Case MP_WAIT
  58.             iWaitCount = iWaitCount + 1
  59.             Screen.MousePointer = 11
  60.         Case MP_NORMAL
  61.             If iWaitCount > 0 Then
  62.                 iWaitCount = iWaitCount - 1
  63.  
  64.                 If iWaitCount = 0 Then Screen.MousePointer = 0
  65.             End If
  66.         Case MP_RESTORE
  67.             iWaitCount = 0
  68.             Screen.MousePointer = 0
  69.     End Select
  70. End Sub
  71.  
  72. Sub BeginWaitPointer()
  73. '----------------------------------------
  74. '--- BeginWaitPointer -------------------
  75. '--
  76. '--   Use this procedure in conjunction with EndWaitPointer to toggle the mouse
  77. '-- pointer between an hourglass, wait mode, and a regular pointer.
  78. '--
  79.  
  80.     Screen.MousePointer = 11                    '-- Set To Hourglass Pointer
  81. End Sub
  82.  
  83. Function BestExportPoint(shp As Object, iSide As Integer) As Integer
  84. '-----------------------------------
  85. '--- BestExportPoint ---------------
  86. '--
  87. '--   Finds the best connection(export) point on a shape for any given side.
  88. '--
  89. '-- Return Value : 1 based index of best export point.
  90. '--
  91.  
  92.     Dim dMax As Double, dResult As Double, cell As Object
  93.     Dim iBest As Integer, iRow As Integer, iCol As Integer
  94.     Dim iRows As Integer
  95.  
  96.     iBest = 1
  97.     dMax = 0
  98.     iRows = shp.RowCount(visSectionExport)
  99.  
  100.     Select Case iSide
  101.         Case SIDE_LEFT, SIDE_RIGHT: iCol = 0
  102.         Case SIDE_TOP, SIDE_BOTTOM: iCol = 1
  103.     End Select
  104.  
  105.     For iRow = 0 To iRows
  106.         Set cell = shp.CellsSRC(visSectionExport, iRow, iCol)
  107.         dResult = cell.ResultIU
  108.         
  109.         Select Case iSide
  110.             Case SIDE_LEFT, SIDE_BOTTOM
  111.                 If dResult < dMax Then
  112.                     dMax = dResult
  113.                     iBest = iRow
  114.                 End If
  115.             Case SIDE_RIGHT, SIDE_TOP
  116.                 If dResult > dMax Then
  117.                     dMax = dResult
  118.                     iBest = iRow
  119.                 End If
  120.         End Select
  121.     Next iRow
  122.  
  123.     BestExportPoint = (iBest + 1)
  124. End Function
  125.  
  126.  
  127. Sub EndWaitPointer()
  128. '----------------------------------------
  129. '--- EndWaitPointer ---------------------
  130. '--
  131. '--   Use this procedure in conjunction with BeginWaitPointer to toggle the mouse
  132. '-- pointer between an hourglass, wait mode, and a regular pointer.
  133. '--
  134.  
  135.     Screen.MousePointer = 0                     '-- Set To Default Mouse Pointer
  136. End Sub
  137.  
  138. Sub GetCtrlHandlePt(shp As Object, iPos As Integer, Pnt As VisPoint)
  139. '-----------------------------------
  140. '--- GetCtrlHandle -----------------
  141. '--
  142. '--   Retrieves a control handle X,Y point structure from a shape.
  143. '--
  144. '-- Parameters   : shp  - Shape sheet to get handle from.
  145. '--                iPos - 1 based index of handle to retrieve.  Do NOT use
  146. '--                       row constants.
  147. '--                Pnt  - Structure to receive control handle's X,Y point.
  148. '--
  149.  
  150.   Dim iRowIndex As Integer
  151.  
  152.   'If Not IsShape(shp) Then Exit Sub     'Called By TotalCtrlPts!
  153.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  154.  
  155.   iRowIndex = visRowFirst + (iPos - 1)      '--   Convert Index
  156.  
  157.   Pnt.X = shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula
  158.   Pnt.Y = shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula
  159. End Sub
  160.  
  161.  
  162. Function HandleCount(shp As Object) As Integer
  163. '-----------------------------------
  164. '--- HandleCount -------------------
  165. '--
  166. '--   Returns the total number of control handles in a shape sheet.  Zero is
  167. '-- returned even if shape is invalid.
  168. '--
  169.  
  170.  HandleCount = shp.RowCount(visSectionControls)
  171.  
  172. End Function
  173.  
  174.  
  175. Sub SetCtrlHandlePt(shp As Object, iPos As Integer, NewPoint As VisPoint)
  176. '-----------------------------------
  177. '--- SetCtrlHandlePt ---------------
  178. '--
  179. '--   Sets a control handles X,Y point only using a VisPoint structure.  No
  180. '-- changes are made unless the point exists.
  181. '--
  182. '-- Parameters   : shp      - Shape sheet to get cell from.
  183. '--                iPos     - 1 based index of control point to replace.  Do not
  184. '--                           use row constants.
  185. '--                NewPoint - Contains new control handle X,Y point.
  186. '--
  187.  
  188.   Dim iRowIndex As Integer
  189.  
  190.   'If Not IsShape(shp) Then Exit Sub 'Called By TotalCtrlPts
  191.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  192.  
  193.   iRowIndex = visRowFirst + (iPos - 1)
  194.  
  195.   shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula = NewPoint.X
  196.   shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula = NewPoint.Y
  197. End Sub
  198.  
  199.  
  200.