LinesForm.frm 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168
  1. VERSION 5.00
  2. Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} LinesForm
  3. Caption = "LinesForm"
  4. ClientHeight = 1620
  5. ClientLeft = 45
  6. ClientTop = 390
  7. ClientWidth = 4680
  8. OleObjectBlob = "LinesForm.frx":0000
  9. StartUpPosition = 1 '所有者中心
  10. End
  11. Attribute VB_Name = "LinesForm"
  12. Attribute VB_GlobalNameSpace = False
  13. Attribute VB_Creatable = False
  14. Attribute VB_PredeclaredId = True
  15. Attribute VB_Exposed = False
  16. '// This is free and unencumbered software released into the public domain.
  17. '// For more information, please refer to https://github.com/hongwenjun
  18. <<<<<<< HEAD
  19. '// 插件名称 VBA_UserForm
  20. Private Const TOOLNAME As String = "LYVBA"
  21. Private Const SECTION As String = "LinesForm"
  22. '// 用户窗口初始化
  23. Private Sub UserForm_Initialize()
  24. With Me
  25. .StartUpPosition = 0
  26. .Left = Val(GetSetting(TOOLNAME, SECTION, "form_left", 900))
  27. .Top = Val(GetSetting(TOOLNAME, SECTION, "form_top", 200))
  28. End With
  29. End Sub
  30. '// 关闭窗口时保存窗口位置
  31. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  32. saveFormPos True
  33. End Sub
  34. '// 保存窗口位置和加载窗口位置
  35. Sub saveFormPos(bDoSave As Boolean)
  36. If bDoSave Then 'save position
  37. SaveSetting TOOLNAME, SECTION, "form_left", Me.Left
  38. SaveSetting TOOLNAME, SECTION, "form_top", Me.Top
  39. End If
  40. End Sub
  41. =======
  42. >>>>>>> 06150b8661ccde06bd8f1e2522c77ce48be72b83
  43. Private Sub MyPen_Click()
  44. On Error GoTo ErrorHandler
  45. API.BeginOpt
  46. lines.Nodes_DrawLines
  47. ErrorHandler:
  48. API.EndOpt
  49. End Sub
  50. '// 左键右键Ctrl三键控制
  51. <<<<<<< HEAD
  52. Private Sub PenDrawLines_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  53. =======
  54. Private Sub PenDrawLines_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  55. >>>>>>> 06150b8661ccde06bd8f1e2522c77ce48be72b83
  56. On Error GoTo ErrorHandler
  57. API.BeginOpt
  58. If Button = 2 Then
  59. lines.Draw_Multiple_Lines cdrAlignVCenter
  60. ElseIf Shift = fmCtrlMask Then
  61. lines.Draw_Multiple_Lines cdrAlignHCenter
  62. Else
  63. lines.Draw_Multiple_Lines 0
  64. End If
  65. ErrorHandler:
  66. API.EndOpt
  67. End Sub
  68. '''//// 傻瓜火车排列 ////'''
  69. Private Sub TOP_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  70. If Button = 2 Then
  71. Tools.Simple_Train_Arrangement 3#
  72. ElseIf Shift = fmCtrlMask Then
  73. Tools.Simple_Train_Arrangement 0#
  74. Else
  75. Tools.Simple_Train_Arrangement Set_Space_Width
  76. End If
  77. End Sub
  78. '''//// 傻瓜阶梯排列 ////'''
  79. Private Sub LEFT_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  80. If Button = 2 Then
  81. Tools.Simple_Ladder_Arrangement 3#
  82. ElseIf Shift = fmCtrlMask Then
  83. Tools.Simple_Ladder_Arrangement 0#
  84. Else
  85. Tools.Simple_Ladder_Arrangement Set_Space_Width
  86. End If
  87. End Sub
  88. Private Sub MakeBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  89. On Error GoTo ErrorHandler
  90. API.BeginOpt
  91. Dim size As Variant
  92. size = input_box_lwh
  93. l = size(0): w = size(1): h = size(2): b = size(3)
  94. If b = 0 Then b = 15
  95. If Button = 2 Then
  96. box.Simple_box_five l, w, h, b
  97. ElseIf Shift = fmCtrlMask Then
  98. box.Simple_box_four l, w, h, b
  99. Else
  100. box.Simple_box_three l, w, h, b
  101. End If
  102. ErrorHandler:
  103. API.EndOpt
  104. End Sub
  105. Private Sub Cmd_3D_Click()
  106. box.Simple_3Deffect
  107. End Sub
  108. '// 角度和旋转工具, 左键左转,右键右转
  109. Private Sub Rotate_Shapes_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  110. If Button = 2 Then '// 右键的代码
  111. Shapes_Rotate -90
  112. ElseIf Shift = fmCtrlMask Then '// 左键的代码
  113. Shapes_Rotate 90
  114. Else '// CTRL的代码
  115. Shapes_Rotate -45
  116. End If
  117. End Sub
  118. '// 移动和再制,我们来制作三键控制,左键只移动,右键是反方向,按CTRL 是复制的
  119. Private Sub Move_Left_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  120. If Button = 2 Then '// 右键的代码
  121. move_shapes 100, 0
  122. ElseIf Shift = fmCtrlMask Then '// 左键的代码
  123. move_shapes -100, 0
  124. Else '// CTRL的代码
  125. Duplicate_shapes -100, 0
  126. End If
  127. End Sub
  128. Private Sub Move_Up_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  129. If Button = 2 Then '// 右键的代码
  130. move_shapes 0, -100
  131. ElseIf Shift = fmCtrlMask Then '// 左键的代码
  132. move_shapes 0, 100
  133. Else '// CTRL的代码
  134. Duplicate_shapes 0, 100
  135. End If
  136. End Sub
  137. Private Sub Average_Distance_BT_Click()
  138. Average_Distance
  139. End Sub
  140. Private Sub chkAutoDistribute_Click()
  141. AutoDistribute_Key = chkAutoDistribute.Value
  142. End Sub