Toolbar.bas 21 KB

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