ThisMacroStorage.cls 2.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788
  1. VERSION 1.0 CLASS
  2. BEGIN
  3. MultiUse = -1 'True
  4. END
  5. Attribute VB_Name = "ThisMacroStorage"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = True
  9. Attribute VB_Exposed = True
  10. #If VBA7 Then
  11. Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  12. #Else
  13. Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  14. #End If
  15. Public sreg As New ShapeRange
  16. Private Sub GlobalMacroStorage_SelectionChange()
  17. On Error GoTo ErrorHandler
  18. Dim n As Long
  19. Dim nr As NodeRange
  20. Dim sh As Shape
  21. If ActiveSelection.Shapes.Count > 0 Then
  22. n = 0
  23. For Each sh In ActiveSelection.Shapes
  24. If sh.Type = cdrCurveShape Then
  25. Set nr = sh.Curve.Selection
  26. n = n + nr.Count
  27. End If
  28. Next sh
  29. If n > 2 Then
  30. LinesForm.Caption = "Nodes: " & n
  31. ElseIf ActiveSelection.Shapes.Count > 1 Then
  32. LinesForm.Caption = "Select: " & ActiveSelection.Shapes.Count
  33. End If
  34. Else
  35. LinesForm.Caption = "LinesForm By Lanya"
  36. End If
  37. If ActiveSelection.Shapes.Count = 1 Then
  38. '// 检测Ctrl:Alt:Shift键状态 17-18-16
  39. If scankey() = 17 Then
  40. If sreg.Exists(ActiveShape) Then sreg.Remove sreg.IndexOf(ActiveShape)
  41. sreg.Add ActiveShape
  42. LinesForm.Caption = "ActiveShape add SREG! Count:" & sreg.Count
  43. End If
  44. If scankey() = 18 Then
  45. sreg.RemoveAll
  46. LinesForm.Caption = "SREG is Removed!"
  47. End If
  48. If scankey() = 16 Then
  49. sreg.CreateSelection
  50. End If
  51. End If
  52. If ActiveSelection.Shapes.Count > 2 And AutoDistribute_Key Then
  53. Dim sr As ShapeRange
  54. Set sr = ActiveSelectionRange
  55. sr.Sort "@shape1.left<@shape2.left"
  56. If first_StaticID <> sr.FirstShape.StaticID Then
  57. Average_Distance
  58. End If
  59. End If
  60. ErrorHandler:
  61. End Sub
  62. Private Function scankey() As Long
  63. Dim ctrlPressed As Boolean
  64. Dim shiftPressed As Boolean
  65. Dim altPressed As Boolean
  66. ' 检测Ctrl键的状态 ' 检测Shift键的状态 ' 检测Alt键的状态
  67. ctrlPressed = GetAsyncKeyState(17) And &H8000
  68. shiftPressed = GetAsyncKeyState(16) And &H8000
  69. altPressed = GetAsyncKeyState(18) And &H8000
  70. scankey = 0
  71. If altPressed Then scankey = 18
  72. If shiftPressed Then scankey = 16
  73. If ctrlPressed Then scankey = 17
  74. End Function