Toolbar.bas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605
  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. mx = x: my = Y
  113. End If
  114. With Me
  115. .Height = 30
  116. End With
  117. End Sub
  118. Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  119. If Button Then
  120. Me.Left = Me.Left - mx + x
  121. Me.Top = Me.Top - my + Y
  122. End If
  123. End Sub
  124. Private Sub LOGO_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  125. If Abs(x - 14) < 14 And Abs(Y - 14) < 14 And Button = 2 Then
  126. Me.Width = 336
  127. OPEN_UI_BIG.Left = 322
  128. UI.Visible = True
  129. LOGO.Visible = False
  130. TOP_ALIGN_BT.Visible = False
  131. LEFT_ALIGN_BT.Visible = False
  132. Exit Sub
  133. ElseIf Shift = fmCtrlMask Then
  134. mx = x: my = Y
  135. Else
  136. Unload Me ' Ctrl + 鼠标 关闭工具
  137. End If
  138. End Sub
  139. Private Sub LOGO_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  140. If Button Then
  141. Me.Left = Me.Left - mx + x
  142. Me.Top = Me.Top - my + Y
  143. End If
  144. End Sub
  145. Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  146. Dim c As New Color
  147. ' 定义图标坐标pos
  148. Dim pos_x As Variant, pos_y As Variant
  149. pos_y = Array(14)
  150. pos_x = Array(14, 41, 67, 94, 121, 148, 174, 201, 228, 254, 281, 308, 334, 361, 388, 415, 441, 468, 495)
  151. '// 按下Ctrl键,最优先处理工具功能
  152. If Shift = 2 Then
  153. If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  154. '// 安全线,清除辅助线
  155. Tools.guideangle CorelDRAW.ActiveSelectionRange, 3 ' 左键 3mm 出血
  156. ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  157. '// Adobe AI EPS INDD PDF和CorelDRAW 缩略图工具
  158. AdobeThumbnail_Click
  159. ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  160. '// 多物件拆分线段
  161. Tools.Split_Segment
  162. ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  163. '// 智能拆字
  164. Tools.Take_Apart_Character
  165. ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  166. '// 暂时空
  167. ElseIf Abs(x - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  168. '// 暂时空
  169. ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  170. '// 暂时空
  171. ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  172. '// CTRL扩展工具栏
  173. Me.Height = 30 + 45
  174. End If
  175. Exit Sub
  176. End If
  177. '// 鼠标右键 扩展键按钮优先 收缩工具栏 标记范围框 居中页面 尺寸取整数 单色黑中线标记 扩展工具栏 排列工具 扩展工具栏收缩
  178. If Button = 2 Then
  179. If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  180. Me.Width = 30: Me.Height = 30
  181. UI.Visible = False: LOGO.Visible = True
  182. ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  183. Tools.居中页面
  184. ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  185. Tools.Mark_Range_Box
  186. ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  187. Tools.尺寸取整
  188. ElseIf Abs(x - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  189. 自动中线色阶条.Auto_ColorMark_K
  190. '//分分合合把几个功能按键合并到一起,定义到右键上
  191. ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  192. Tools.分分合合
  193. ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  194. 智能群组和查找.智能群组 API.Create_Tolerance
  195. ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  196. '// 右键扩展工具栏
  197. Me.Height = 30 + 45
  198. ElseIf Abs(x - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  199. '// 右键拆分线段
  200. Tools.Split_Segment
  201. ElseIf Abs(x - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  202. '// 右键排列工具
  203. TOP_ALIGN_BT.Visible = True
  204. LEFT_ALIGN_BT.Visible = True
  205. ElseIf Abs(x - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  206. '// 右键扩展工具栏收缩
  207. Me.Height = 30
  208. End If
  209. Exit Sub
  210. End If
  211. '// 鼠标左键 单击按钮功能 按工具栏上图标正常功能
  212. If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  213. 裁切线.start
  214. ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  215. 剪贴板尺寸建立矩形.start
  216. ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  217. 裁切线.SelectLine_to_Cropline
  218. ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  219. 拼版裁切线.arrange
  220. ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  221. 拼版裁切线.Cut_lines
  222. ElseIf Abs(x - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  223. 自动中线色阶条.Auto_ColorMark
  224. ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  225. 智能群组和查找.智能群组
  226. ElseIf Abs(x - pos_x(7)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  227. CQL_FIND_UI.Show 0
  228. ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  229. Replace_UI.Show 0
  230. ElseIf Abs(x - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  231. Tools.TextShape_ConvertToCurves
  232. ElseIf Abs(x - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  233. '// 扩展工具栏
  234. Me.Height = 30 + 45
  235. Speak_Msg "左右键有不同功能"
  236. ElseIf Abs(x - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 Then
  237. If Me.Height > 30 Then
  238. Me.Height = 30
  239. Else
  240. '// 最小化
  241. Me.Width = 30
  242. Me.Height = 30
  243. OPEN_UI_BIG.Left = 31
  244. UI.Visible = False
  245. LOGO.Visible = True
  246. ' 保存工具条位置 Left 和 Top
  247. SaveSetting "262235.xyz", "Settings", "Left", Me.Left
  248. SaveSetting "262235.xyz", "Settings", "Top", Me.Top
  249. Speak_Msg "左键缩小 右键收缩"
  250. End If
  251. End If
  252. End Sub
  253. Private Sub X_EXIT_Click()
  254. Unload Me ' 关闭
  255. End Sub
  256. '// 多页合并工具,已经合并到主线工具
  257. ' Private Sub 调用多页合并工具()
  258. ' Dim value As Integer
  259. ' value = GMSManager.RunMacro("合并多页工具", "合并多页运行.run")
  260. ' End Sub
  261. '''/// 贪心商人和好玩工具等 ///'''
  262. Private Sub Cdr_Nodes_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  263. If Button = 2 Then
  264. TSP.Nodes_To_TSP
  265. ElseIf Shift = fmCtrlMask Then
  266. TSP.CDR_TO_TSP
  267. Else
  268. ' Ctrl + 鼠标 空
  269. End If
  270. End Sub
  271. Private Sub Cdr_Nodes_BT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  272. TSP_L1.ForeColor = RGB(0, 150, 255)
  273. End Sub
  274. Private Sub START_TSP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  275. TSP_L2.ForeColor = RGB(0, 150, 255)
  276. End Sub
  277. Private Sub PATH_TO_TSP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  278. TSP_L3.ForeColor = RGB(0, 150, 255)
  279. End Sub
  280. Private Sub TSP2DRAW_LINE_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  281. TSP_L4.ForeColor = RGB(0, 150, 255)
  282. End Sub
  283. Private Sub TSP2DRAW_LINE_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  284. If Button = 2 Then
  285. TSP.TSP_TO_DRAW_LINE
  286. ElseIf Shift = fmCtrlMask Then
  287. TSP.TSP_TO_DRAW_LINES
  288. Else
  289. ' Ctrl + 鼠标 空
  290. End If
  291. End Sub
  292. Private Sub START_TSP_Click()
  293. TSP.START_TSP
  294. End Sub
  295. Private Sub PATH_TO_TSP_Click()
  296. TSP.MAKE_TSP
  297. End Sub
  298. Private Sub BITMAP_BUILD_Click()
  299. Tools.Python_BITMAP
  300. End Sub
  301. Private Sub BITMAP_BUILD2_Click()
  302. Tools.Python_BITMAP2
  303. End Sub
  304. Private Sub BITMAP_MAKE_DOTS_Click()
  305. TSP.BITMAP_MAKE_DOTS
  306. End Sub
  307. '''/// Python脚本和二维码等 ///'''
  308. Private Sub Organize_Size_Click()
  309. Tools.Python_Organize_Size
  310. End Sub
  311. Private Sub Get_Number_Click()
  312. Tools.Python_Get_Barcode_Number
  313. End Sub
  314. Private Sub Make_QRCode_Click()
  315. Tools.Python_Make_QRCode
  316. Tools.QRCode_replace
  317. End Sub
  318. Private Sub QR2Vector_Click()
  319. Tools.QRCode_to_Vector
  320. End Sub
  321. Private Sub OPEN_UI_BIG_Click()
  322. Unload Me
  323. CorelVBA.Show 0
  324. End Sub
  325. Private Sub Settings_Click()
  326. If 0 < Val(Bleed.text) * Val(Line_len.text) < 100 Then
  327. SaveSetting "262235.xyz", "Settings", "Bleed", Bleed.text
  328. SaveSetting "262235.xyz", "Settings", "Line_len", Line_len.text
  329. SaveSetting "262235.xyz", "Settings", "Outline_Width", Outline_Width.text
  330. End If
  331. ' 保存工具条位置 Left 和 Top
  332. SaveSetting "262235.xyz", "Settings", "Left", Me.Left
  333. SaveSetting "262235.xyz", "Settings", "Top", Me.Top
  334. Me.Height = 30
  335. End Sub
  336. '''///////// 图标鼠标左右点击功能调用 /////////'''
  337. Private Sub Tools_Icon_Click()
  338. ' 调用语句
  339. I = GMSManager.RunMacro("CorelDRAW_VBA", "学习CorelVBA.start")
  340. End Sub
  341. '''//// 选择多物件,组合然后拆分线段,为角线爬虫准备 ////'''
  342. Private Sub Split_Segment_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  343. If Button = 2 Then
  344. MsgBox "鼠标右键,功能待定"
  345. Exit Sub
  346. End If
  347. If Button Then
  348. Tools.Split_Segment
  349. End If
  350. End Sub
  351. Private Sub Split_Segment_Copy_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  352. If Button = 2 Then
  353. MsgBox "鼠标右键,功能待定"
  354. Exit Sub
  355. End If
  356. If Button Then
  357. Tools.Split_Segment
  358. End If
  359. Speak_Msg "拆分线段"
  360. End Sub
  361. '''//// CorelDRAW 与 Adobe_Illustrator 剪贴板转换 ////'''
  362. Private Sub Adobe_Illustrator_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  363. Dim value As Integer
  364. If Button = 2 Then
  365. value = GMSManager.RunMacro("AIClipboard", "CopyPaste.PasteAIFormat")
  366. Exit Sub
  367. End If
  368. If Button Then
  369. value = GMSManager.RunMacro("AIClipboard", "CopyPaste.CopyAIFormat")
  370. MsgBox "CorelDRAW 与 Adobe_Illustrator 剪贴板转换" & vbNewLine & "鼠标左键复制,鼠标右键粘贴"
  371. End If
  372. End Sub
  373. '''//// 标记画框 支持容差 ////'''
  374. Private Sub Mark_CreateRectangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  375. If Button = 2 Then
  376. Tools.Mark_CreateRectangle True
  377. ElseIf Shift = fmCtrlMask Then
  378. Tools.Mark_CreateRectangle False
  379. Else
  380. Create_Tolerance
  381. End If
  382. Speak_Msg "标记画框 右键支持容差"
  383. End Sub
  384. '''//// 一键拆开多行组合的文字字符 ////'''
  385. Private Sub Batch_Combine_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  386. If Button = 2 Then
  387. Tools.Batch_Combine
  388. ElseIf Shift = fmCtrlMask Then
  389. Tools.Take_Apart_Character
  390. Else
  391. Create_Tolerance
  392. End If
  393. Speak_Msg "智能拆字"
  394. End Sub
  395. '''//// 简单一刀切 ////'''
  396. Private Sub Single_Line_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  397. If Button = 2 Then
  398. Tools.Single_Line_Vertical
  399. ElseIf Shift = fmCtrlMask Then
  400. Tools.Single_Line
  401. Else
  402. Tools.Single_Line_LastNode
  403. End If
  404. Speak_Msg "简单一刀切"
  405. End Sub
  406. '''//// 傻瓜火车排列 ////'''
  407. Private Sub TOP_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  408. If Button = 2 Then
  409. Tools.傻瓜火车排列 3#
  410. ElseIf Shift = fmCtrlMask Then
  411. Tools.傻瓜火车排列 0#
  412. Else
  413. Tools.傻瓜火车排列 Set_Space_Width
  414. End If
  415. End Sub
  416. '''//// 傻瓜阶梯排列 ////'''
  417. Private Sub LEFT_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  418. If Button = 2 Then
  419. Tools.傻瓜阶梯排列 3#
  420. ElseIf Shift = fmCtrlMask Then
  421. Tools.傻瓜阶梯排列 0#
  422. Else
  423. Tools.傻瓜阶梯排列 Set_Space_Width
  424. End If
  425. End Sub
  426. '''//// 左键-多页合并一页工具 右键-批量多页居中 ////'''
  427. Private Sub UniteOne_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  428. If Button = 2 Then
  429. Tools.批量多页居中
  430. ElseIf Shift = fmCtrlMask Then
  431. UniteOne.Show 0
  432. Speak_Msg "多页合并一页"
  433. Else
  434. ' Ctrl + 鼠标 空
  435. End If
  436. End Sub
  437. '''//// Adobe AI EPS INDD PDF和CorelDRAW 缩略图工具 ////'''
  438. Private Sub AdobeThumbnail_Click()
  439. Dim h As Long, r As Long
  440. mypath = Path & "GMS\262235.xyz\"
  441. App = mypath & "GuiAdobeThumbnail.exe"
  442. h = FindWindow(vbNullString, "CorelVBA 青年节 By 蘭雅sRGB")
  443. I = ShellExecute(h, "", App, "", mypath, 1)
  444. End Sub
  445. '''//// 快速颜色选择 ////'''
  446. Private Sub Quick_Color_Select_Click()
  447. Tools.quickColorSelect
  448. End Sub
  449. Private Sub Cut_Cake_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  450. If Button = 2 Then
  451. Tools.divideVertically
  452. ElseIf Shift = fmCtrlMask Then
  453. Tools.divideHorizontally
  454. Else
  455. ' Ctrl + 鼠标 空
  456. End If
  457. End Sub
  458. '// 安全辅助线功能,三键控制,讨厌辅助线的也可以用来删除辅助线
  459. Private Sub Safe_Guideangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  460. If Button = 2 Then
  461. Tools.guideangle CorelDRAW.ActiveSelectionRange, 0# ' 右键0距离贴紧
  462. ElseIf Shift = fmCtrlMask Then
  463. Tools.guideangle CorelDRAW.ActiveSelectionRange, 3 ' 左键 3mm 出血
  464. Else
  465. Tools.guideangle CorelDRAW.ActiveSelectionRange, -Set_Space_Width ' Ctrl + 鼠标左键 自定义间隔
  466. End If
  467. End Sub
  468. '// 小工具快速启动
  469. Private Sub Open_Calc_Click()
  470. Launcher.START_Calc
  471. End Sub
  472. Private Sub Open_Notepad_Click()
  473. Launcher.START_Notepad
  474. End Sub
  475. Private Sub ImageReader_Click()
  476. Launcher.START_Barcode_ImageReader
  477. End Sub
  478. Private Sub Video_Camera_Click()
  479. Launcher.START_Bandicam
  480. End Sub
  481. Private Sub myfonts_Click()
  482. Launcher.START_whatthefont
  483. End Sub
  484. Private Sub VectorMagic_Click()
  485. Launcher.START_Vector_Magic
  486. End Sub
  487. Private Sub waifu2x_Click()
  488. Launcher.START_waifu2x
  489. End Sub