Toolbar.bas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704
  1. VERSION 5.00
  2. Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Toolbar
  3. Caption = "Toolbar"
  4. ClientHeight = 4230
  5. ClientLeft = 45
  6. ClientTop = 330
  7. ClientWidth = 6840
  8. OleObjectBlob = "Toolbar.frx":0000
  9. End
  10. Attribute VB_Name = "Toolbar"
  11. Attribute VB_GlobalNameSpace = False
  12. Attribute VB_Creatable = False
  13. Attribute VB_PredeclaredId = True
  14. Attribute VB_Exposed = False
  15. #If VBA7 Then
  16. Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  17. Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
  18. Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  19. Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  20. Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  21. Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  22. Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  23. #Else
  24. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  25. Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
  26. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  27. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  28. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  29. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  30. Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  31. #End If
  32. Private Const GWL_STYLE As Long = (-16)
  33. Private Const GWL_EXSTYLE = (-20)
  34. Private Const WS_CAPTION As Long = &HC00000
  35. Private Const WS_EX_DLGMODALFRAME = &H1&
  36. 'Constants for transparency
  37. Private Const WS_EX_LAYERED = &H80000
  38. Private Const LWA_COLORKEY = &H1 'Chroma key for fading a certain color on your Form
  39. Private Const LWA_ALPHA = &H2 'Only needed if you want to fade the entire userform
  40. Public UIL_Key As Boolean
  41. Public pic1, pic2
  42. Private Sub MakeUserFormTransparent(frm As Object, Optional Color As Variant)
  43. 'set transparencies on userform
  44. Dim formhandle As Long
  45. Dim bytOpacity As Byte
  46. formhandle = FindWindow(vbNullString, Me.Caption)
  47. If IsMissing(Color) Then Color = vbWhite 'default to vbwhite
  48. bytOpacity = 100 ' variable keeping opacity setting
  49. SetWindowLong formhandle, GWL_EXSTYLE, GetWindowLong(formhandle, GWL_EXSTYLE) Or WS_EX_LAYERED
  50. 'The following line makes only a certain color transparent so the
  51. ' background of the form and any object whose BackColor you've set to match
  52. ' vbColor (default vbWhite) will be transparent.
  53. Me.BackColor = Color
  54. SetLayeredWindowAttributes formhandle, Color, bytOpacity, LWA_COLORKEY
  55. End Sub
  56. Private Sub Change_UI_Close_Voice_Click()
  57. Speak_Msg "修改UI图片更换界面 注册表关闭语音 详QQ群"
  58. MsgBox "请给我支持!" & vbNewLine & "您的支持,我才能有动力添加更多功能." & vbNewLine & "蘭雅CorelVBA中秋节版" & vbNewLine & "coreldrawvba插件交流群 8531411"
  59. End Sub
  60. Private Sub UserForm_Initialize()
  61. Dim IStyle As Long
  62. Dim hWnd As Long
  63. hWnd = FindWindow("ThunderDFrame", Me.Caption)
  64. IStyle = GetWindowLong(hWnd, GWL_STYLE)
  65. IStyle = IStyle And Not WS_CAPTION
  66. SetWindowLong hWnd, GWL_STYLE, IStyle
  67. DrawMenuBar hWnd
  68. IStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
  69. SetWindowLong hWnd, GWL_EXSTYLE, IStyle
  70. With Me
  71. .StartUpPosition = 0
  72. .Left = Val(GetSetting("262235.xyz", "Settings", "Left", "400")) ' 设置工具栏位置
  73. .Top = Val(GetSetting("262235.xyz", "Settings", "Top", "55"))
  74. .Height = 30
  75. .Width = 336
  76. End With
  77. OutlineKey = True
  78. OptKey = True
  79. ' 读取角线设置
  80. Bleed.text = API.GetSet("Bleed")
  81. Line_len.text = API.GetSet("Line_len")
  82. Outline_Width.text = GetSetting("262235.xyz", "Settings", "Outline_Width", "0.2")
  83. UIFile = Path & "GMS\262235.xyz\ToolBar.jpg"
  84. If API.ExistsFile_UseFso(UIFile) Then
  85. UI.Picture = LoadPicture(UIFile) '换UI图
  86. Set pic1 = LoadPicture(UIFile)
  87. End If
  88. UIL = Path & "GMS\262235.xyz\ToolBar1.jpg"
  89. If API.ExistsFile_UseFso(UIL) Then
  90. Set pic2 = LoadPicture(UIL)
  91. UIL_Key = True
  92. End If
  93. ' 窗口透明, 最小化只显示一个图标
  94. #If VBA7 Then
  95. MakeUserFormTransparent Me, RGB(26, 22, 35)
  96. #Else
  97. ' CorelDRAW X4 / Windows7 自用关闭透明
  98. #End If
  99. End Sub
  100. Private Sub UI_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  101. UI.Visible = False
  102. If Y > 1 And Y < 16 And UIL_Key Then
  103. UI.Picture = pic2
  104. ElseIf Y > 16 And UIL_Key Then
  105. UI.Picture = pic1
  106. End If
  107. UI.Visible = True
  108. ' Debug.Print X & " , " & Y
  109. End Sub
  110. Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  111. If Button Then
  112. <<<<<<< HEAD
  113. mx = X: my = Y
  114. =======
  115. mx = x: my = Y
  116. >>>>>>> 0d7a93841c2ece54be5b9b16995c7a3e4d8c3296
  117. End If
  118. With Me
  119. .Height = 30
  120. End With
  121. End Sub
  122. Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  123. If Button Then
  124. Me.Left = Me.Left - mx + X
  125. Me.Top = Me.Top - my + Y
  126. End If
  127. End Sub
  128. Private Sub LOGO_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  129. If Abs(X - 14) < 14 And Abs(Y - 14) < 14 And Button = 2 Then
  130. Me.Width = 336
  131. OPEN_UI_BIG.Left = 322
  132. UI.Visible = True
  133. LOGO.Visible = False
  134. TOP_ALIGN_BT.Visible = False
  135. LEFT_ALIGN_BT.Visible = False
  136. Exit Sub
  137. ElseIf Shift = fmCtrlMask Then
  138. <<<<<<< HEAD
  139. mx = X: my = Y
  140. =======
  141. mx = x: my = Y
  142. >>>>>>> 0d7a93841c2ece54be5b9b16995c7a3e4d8c3296
  143. Else
  144. Unload Me ' Ctrl + 鼠标 关闭工具
  145. End If
  146. End Sub
  147. Private Sub LOGO_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  148. If Button Then
  149. Me.Left = Me.Left - mx + X
  150. Me.Top = Me.Top - my + Y
  151. End If
  152. End Sub
  153. Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  154. Dim c As New Color
  155. ' 定义图标坐标pos
  156. Dim pos_x As Variant, pos_y As Variant
  157. pos_y = Array(14)
  158. pos_x = Array(14, 41, 67, 94, 121, 148, 174, 201, 228, 254, 281, 308, 334, 361, 388, 415, 441, 468, 495)
  159. '// 按下Ctrl键,最优先处理工具功能
  160. If Shift = 2 Then
  161. <<<<<<< HEAD
  162. If Abs(X - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  163. '// 安全线,清除辅助线
  164. Tools.guideangle CorelDRAW.ActiveSelectionRange, 3 ' 左键 3mm 出血
  165. ElseIf Abs(X - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  166. '// Adobe AI EPS INDD PDF和CorelDRAW 缩略图工具
  167. AdobeThumbnail_Click
  168. ElseIf Abs(X - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  169. '// 多物件拆分线段
  170. Tools.Split_Segment
  171. ElseIf Abs(X - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  172. '// 智能拆字
  173. Tools.Take_Apart_Character
  174. ElseIf Abs(X - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  175. '// 暂时空
  176. ElseIf Abs(X - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  177. '// 暂时空
  178. ElseIf Abs(X - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  179. '// 暂时空
  180. ElseIf Abs(X - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  181. =======
  182. If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  183. '// 安全线,清除辅助线
  184. Tools.guideangle CorelDRAW.ActiveSelectionRange, 3 ' 左键 3mm 出血
  185. ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  186. '// Adobe AI EPS INDD PDF和CorelDRAW 缩略图工具
  187. AdobeThumbnail_Click
  188. ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  189. '// 多物件拆分线段
  190. Tools.Split_Segment
  191. ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  192. '// 智能拆字
  193. Tools.Take_Apart_Character
  194. ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  195. '// 暂时空
  196. ElseIf Abs(x - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  197. '// 暂时空
  198. ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  199. '// 暂时空
  200. ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  201. >>>>>>> 0d7a93841c2ece54be5b9b16995c7a3e4d8c3296
  202. '// CTRL扩展工具栏
  203. Me.Height = 30 + 45
  204. End If
  205. Exit Sub
  206. End If
  207. '// 鼠标右键 扩展键按钮优先 收缩工具栏 标记范围框 居中页面 尺寸取整数 单色黑中线标记 扩展工具栏 排列工具 扩展工具栏收缩
  208. If Button = 2 Then
  209. <<<<<<< HEAD
  210. If Abs(X - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  211. Me.Width = 30: Me.Height = 30
  212. UI.Visible = False: LOGO.Visible = True
  213. ElseIf Abs(X - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  214. Tools.居中页面
  215. ElseIf Abs(X - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  216. Tools.Mark_Range_Box
  217. ElseIf Abs(X - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  218. Tools.尺寸取整
  219. ElseIf Abs(X - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  220. 自动中线色阶条.Auto_ColorMark_K
  221. '//分分合合把几个功能按键合并到一起,定义到右键上
  222. ElseIf Abs(X - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  223. Tools.分分合合
  224. ElseIf Abs(X - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  225. 智能群组和查找.智能群组 API.Create_Tolerance
  226. ElseIf Abs(X - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  227. '// 右键扩展工具栏
  228. Me.Height = 30 + 45
  229. ElseIf Abs(X - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  230. '// 右键拆分线段
  231. Tools.Split_Segment
  232. ElseIf Abs(X - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  233. =======
  234. If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  235. Me.Width = 30: Me.Height = 30
  236. UI.Visible = False: LOGO.Visible = True
  237. ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  238. Tools.居中页面
  239. ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  240. Tools.Mark_Range_Box
  241. ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  242. Tools.尺寸取整
  243. ElseIf Abs(x - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  244. 自动中线色阶条.Auto_ColorMark_K
  245. '//分分合合把几个功能按键合并到一起,定义到右键上
  246. ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  247. Tools.分分合合
  248. ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  249. 智能群组和查找.智能群组 API.Create_Tolerance
  250. ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  251. '// 右键扩展工具栏
  252. Me.Height = 30 + 45
  253. ElseIf Abs(x - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  254. '// 右键拆分线段
  255. Tools.Split_Segment
  256. ElseIf Abs(x - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  257. >>>>>>> 0d7a93841c2ece54be5b9b16995c7a3e4d8c3296
  258. '// 右键排列工具
  259. TOP_ALIGN_BT.Visible = True
  260. LEFT_ALIGN_BT.Visible = True
  261. <<<<<<< HEAD
  262. ElseIf Abs(X - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  263. =======
  264. ElseIf Abs(x - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  265. >>>>>>> 0d7a93841c2ece54be5b9b16995c7a3e4d8c3296
  266. '// 右键扩展工具栏收缩
  267. Me.Height = 30
  268. End If
  269. Exit Sub
  270. End If
  271. '// 鼠标左键 单击按钮功能 按工具栏上图标正常功能
  272. If Abs(X - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  273. 裁切线.start
  274. ElseIf Abs(X - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  275. 剪贴板尺寸建立矩形.start
  276. ElseIf Abs(X - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  277. 裁切线.SelectLine_to_Cropline
  278. ElseIf Abs(X - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  279. 拼版裁切线.arrange
  280. ElseIf Abs(X - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  281. 拼版裁切线.Cut_lines
  282. ElseIf Abs(X - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  283. 自动中线色阶条.Auto_ColorMark
  284. ElseIf Abs(X - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  285. 智能群组和查找.智能群组
  286. ElseIf Abs(X - pos_x(7)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  287. CQL_FIND_UI.Show 0
  288. ElseIf Abs(X - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  289. Replace_UI.Show 0
  290. ElseIf Abs(X - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  291. Tools.TextShape_ConvertToCurves
  292. ElseIf Abs(X - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  293. '// 扩展工具栏
  294. Me.Height = 30 + 45
  295. Speak_Msg "左右键有不同功能"
  296. ElseIf Abs(X - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  297. If Me.Height > 30 Then
  298. Me.Height = 30
  299. Else
  300. '// 最小化
  301. Me.Width = 30
  302. Me.Height = 30
  303. OPEN_UI_BIG.Left = 31
  304. UI.Visible = False
  305. LOGO.Visible = True
  306. ' 保存工具条位置 Left 和 Top
  307. SaveSetting "262235.xyz", "Settings", "Left", Me.Left
  308. SaveSetting "262235.xyz", "Settings", "Top", Me.Top
  309. Speak_Msg "左键缩小 右键收缩"
  310. End If
  311. End If
  312. End Sub
  313. Private Sub X_EXIT_Click()
  314. Unload Me ' 关闭
  315. End Sub
  316. '// 多页合并工具,已经合并到主线工具
  317. ' Private Sub 调用多页合并工具()
  318. ' Dim value As Integer
  319. ' value = GMSManager.RunMacro("合并多页工具", "合并多页运行.run")
  320. ' End Sub
  321. '''/// 贪心商人和好玩工具等 ///'''
  322. <<<<<<< HEAD
  323. Private Sub Cdr_Nodes_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  324. =======
  325. Private Sub Cdr_Nodes_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  326. >>>>>>> 0d7a93841c2ece54be5b9b16995c7a3e4d8c3296
  327. If Button = 2 Then
  328. TSP.Nodes_To_TSP
  329. ElseIf Shift = fmCtrlMask Then
  330. TSP.CDR_TO_TSP
  331. Else
  332. ' Ctrl + 鼠标 空
  333. End If
  334. End Sub
  335. Private Sub Cdr_Nodes_BT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  336. TSP_L1.ForeColor = RGB(0, 150, 255)
  337. End Sub
  338. Private Sub START_TSP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  339. TSP_L2.ForeColor = RGB(0, 150, 255)
  340. End Sub
  341. Private Sub PATH_TO_TSP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  342. TSP_L3.ForeColor = RGB(0, 150, 255)
  343. End Sub
  344. Private Sub TSP2DRAW_LINE_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  345. TSP_L4.ForeColor = RGB(0, 150, 255)
  346. End Sub
  347. Private Sub TSP2DRAW_LINE_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  348. If Button = 2 Then
  349. TSP.TSP_TO_DRAW_LINE
  350. ElseIf Shift = fmCtrlMask Then
  351. TSP.TSP_TO_DRAW_LINES
  352. Else
  353. ' Ctrl + 鼠标 空
  354. End If
  355. End Sub
  356. Private Sub START_TSP_Click()
  357. TSP.START_TSP
  358. End Sub
  359. Private Sub PATH_TO_TSP_Click()
  360. TSP.MAKE_TSP
  361. End Sub
  362. Private Sub BITMAP_BUILD_Click()
  363. Tools.Python_BITMAP
  364. End Sub
  365. Private Sub BITMAP_BUILD2_Click()
  366. Tools.Python_BITMAP2
  367. End Sub
  368. Private Sub BITMAP_MAKE_DOTS_Click()
  369. TSP.BITMAP_MAKE_DOTS
  370. End Sub
  371. '''/// Python脚本和二维码等 ///'''
  372. Private Sub Organize_Size_Click()
  373. Tools.Python_Organize_Size
  374. End Sub
  375. Private Sub Get_Number_Click()
  376. Tools.Python_Get_Barcode_Number
  377. End Sub
  378. Private Sub Make_QRCode_Click()
  379. Tools.Python_Make_QRCode
  380. Tools.QRCode_replace
  381. End Sub
  382. Private Sub QR2Vector_Click()
  383. Tools.QRCode_to_Vector
  384. End Sub
  385. Private Sub OPEN_UI_BIG_Click()
  386. Unload Me
  387. CorelVBA.Show 0
  388. End Sub
  389. Private Sub Settings_Click()
  390. If 0 < Val(Bleed.text) * Val(Line_len.text) < 100 Then
  391. SaveSetting "262235.xyz", "Settings", "Bleed", Bleed.text
  392. SaveSetting "262235.xyz", "Settings", "Line_len", Line_len.text
  393. SaveSetting "262235.xyz", "Settings", "Outline_Width", Outline_Width.text
  394. End If
  395. ' 保存工具条位置 Left 和 Top
  396. SaveSetting "262235.xyz", "Settings", "Left", Me.Left
  397. SaveSetting "262235.xyz", "Settings", "Top", Me.Top
  398. Me.Height = 30
  399. End Sub
  400. '''///////// 图标鼠标左右点击功能调用 /////////'''
  401. Private Sub Tools_Icon_Click()
  402. ' 调用语句
  403. I = GMSManager.RunMacro("CorelDRAW_VBA", "学习CorelVBA.start")
  404. End Sub
  405. '''//// 选择多物件,组合然后拆分线段,为角线爬虫准备 ////'''
  406. Private Sub Split_Segment_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  407. If Button = 2 Then
  408. MsgBox "鼠标右键,功能待定"
  409. Exit Sub
  410. End If
  411. If Button Then
  412. Tools.Split_Segment
  413. End If
  414. End Sub
  415. Private Sub Split_Segment_Copy_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  416. If Button = 2 Then
  417. MsgBox "左键拆分线段,Ctrl合并线段"
  418. ElseIf Shift = fmCtrlMask Then
  419. Tools.Split_Segment
  420. Else
  421. ActiveSelection.CustomCommand "ConvertTo", "JoinCurves"
  422. Application.Refresh
  423. End If
  424. Speak_Msg "拆分线段,Ctrl合并线段"
  425. End Sub
  426. '''//// CorelDRAW 与 Adobe_Illustrator 剪贴板转换 ////'''
  427. Private Sub Adobe_Illustrator_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  428. Dim value As Integer
  429. If Button = 2 Then
  430. value = GMSManager.RunMacro("AIClipboard", "CopyPaste.PasteAIFormat")
  431. Exit Sub
  432. End If
  433. If Button Then
  434. value = GMSManager.RunMacro("AIClipboard", "CopyPaste.CopyAIFormat")
  435. MsgBox "CorelDRAW 与 Adobe_Illustrator 剪贴板转换" & vbNewLine & "鼠标左键复制,鼠标右键粘贴"
  436. End If
  437. End Sub
  438. '''//// 标记画框 支持容差 ////'''
  439. Private Sub Mark_CreateRectangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  440. If Button = 2 Then
  441. Tools.Mark_CreateRectangle True
  442. ElseIf Shift = fmCtrlMask Then
  443. Tools.Mark_CreateRectangle False
  444. Else
  445. Create_Tolerance
  446. End If
  447. Speak_Msg "标记画框 右键支持容差"
  448. End Sub
  449. '''//// 一键拆开多行组合的文字字符 ////'''
  450. Private Sub Batch_Combine_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  451. If Button = 2 Then
  452. Tools.Batch_Combine
  453. ElseIf Shift = fmCtrlMask Then
  454. Tools.Take_Apart_Character
  455. Else
  456. Create_Tolerance
  457. End If
  458. Speak_Msg "智能拆字"
  459. End Sub
  460. '''//// 简单一刀切 ////'''
  461. Private Sub Single_Line_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  462. If Button = 2 Then
  463. Tools.Single_Line_Vertical
  464. ElseIf Shift = fmCtrlMask Then
  465. Tools.Single_Line
  466. Else
  467. Tools.Single_Line_LastNode
  468. End If
  469. Speak_Msg "简单一刀切"
  470. End Sub
  471. '''//// 傻瓜火车排列 ////'''
  472. Private Sub TOP_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  473. If Button = 2 Then
  474. Tools.傻瓜火车排列 3#
  475. ElseIf Shift = fmCtrlMask Then
  476. Tools.傻瓜火车排列 0#
  477. Else
  478. Tools.傻瓜火车排列 Set_Space_Width
  479. End If
  480. End Sub
  481. '''//// 傻瓜阶梯排列 ////'''
  482. Private Sub LEFT_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  483. If Button = 2 Then
  484. Tools.傻瓜阶梯排列 3#
  485. ElseIf Shift = fmCtrlMask Then
  486. Tools.傻瓜阶梯排列 0#
  487. Else
  488. Tools.傻瓜阶梯排列 Set_Space_Width
  489. End If
  490. End Sub
  491. '''//// 左键-多页合并一页工具 右键-批量多页居中 ////'''
  492. Private Sub UniteOne_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  493. If Button = 2 Then
  494. Tools.批量多页居中
  495. ElseIf Shift = fmCtrlMask Then
  496. UniteOne.Show 0
  497. Speak_Msg "多页合并一页"
  498. Else
  499. ' Ctrl + 鼠标 空
  500. End If
  501. End Sub
  502. '''//// Adobe AI EPS INDD PDF和CorelDRAW 缩略图工具 ////'''
  503. Private Sub AdobeThumbnail_Click()
  504. Dim h As Long, r As Long
  505. mypath = Path & "GMS\262235.xyz\"
  506. App = mypath & "GuiAdobeThumbnail.exe"
  507. h = FindWindow(vbNullString, "CorelVBA 青年节 By 蘭雅sRGB")
  508. I = ShellExecute(h, "", App, "", mypath, 1)
  509. End Sub
  510. '''//// 快速颜色选择 ////'''
  511. Private Sub Quick_Color_Select_Click()
  512. Tools.quickColorSelect
  513. End Sub
  514. Private Sub Cut_Cake_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  515. If Button = 2 Then
  516. Tools.divideVertically
  517. ElseIf Shift = fmCtrlMask Then
  518. Tools.divideHorizontally
  519. Else
  520. ' Ctrl + 鼠标 空
  521. End If
  522. End Sub
  523. '// 安全辅助线功能,三键控制,讨厌辅助线的也可以用来删除辅助线
  524. Private Sub Safe_Guideangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  525. If Button = 2 Then
  526. Tools.guideangle CorelDRAW.ActiveSelectionRange, 0# ' 右键0距离贴紧
  527. ElseIf Shift = fmCtrlMask Then
  528. Tools.guideangle CorelDRAW.ActiveSelectionRange, 3 ' 左键 3mm 出血
  529. Else
  530. Tools.guideangle CorelDRAW.ActiveSelectionRange, -Set_Space_Width ' Ctrl + 鼠标左键 自定义间隔
  531. <<<<<<< HEAD
  532. End If
  533. End Sub
  534. Private Sub btn_makesizes_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  535. If Button = 2 Then
  536. Make_SIZE.Show 0 ' 右键
  537. ElseIf Shift = fmCtrlMask Then
  538. #If VBA7 Then
  539. woodman.Show 0
  540. #Else ' X4 使用
  541. Make_SIZE.Show 0
  542. #End If
  543. Else
  544. Tools.Simple_Label_Numbers ' Ctrl + 鼠标 批量简单数字标注
  545. =======
  546. >>>>>>> 0d7a93841c2ece54be5b9b16995c7a3e4d8c3296
  547. End If
  548. End Sub
  549. '// 小工具快速启动
  550. Private Sub Open_Calc_Click()
  551. Launcher.START_Calc
  552. End Sub
  553. Private Sub Open_Notepad_Click()
  554. Launcher.START_Notepad
  555. End Sub
  556. Private Sub ImageReader_Click()
  557. Launcher.START_Barcode_ImageReader
  558. End Sub
  559. Private Sub Video_Camera_Click()
  560. Launcher.START_Bandicam
  561. End Sub
  562. Private Sub myfonts_Click()
  563. Launcher.START_whatthefont
  564. End Sub
  565. Private Sub VectorMagic_Click()
  566. Launcher.START_Vector_Magic
  567. End Sub
  568. Private Sub waifu2x_Click()
  569. Launcher.START_waifu2x
  570. End Sub