1
1

Toolbar.bas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652
  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 "左键拆分线段,Ctrl合并线段"
  354. ElseIf Shift = fmCtrlMask Then
  355. Tools.Split_Segment
  356. Else
  357. ActiveSelection.CustomCommand "ConvertTo", "JoinCurves"
  358. Application.Refresh
  359. End If
  360. Speak_Msg "拆分线段,Ctrl合并线段"
  361. End Sub
  362. '''//// CorelDRAW 与 Adobe_Illustrator 剪贴板转换 ////'''
  363. Private Sub Adobe_Illustrator_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  364. Dim value As Integer
  365. If Button = 2 Then
  366. value = GMSManager.RunMacro("AIClipboard", "CopyPaste.PasteAIFormat")
  367. Exit Sub
  368. End If
  369. If Button Then
  370. value = GMSManager.RunMacro("AIClipboard", "CopyPaste.CopyAIFormat")
  371. MsgBox "CorelDRAW 与 Adobe_Illustrator 剪贴板转换" & vbNewLine & "鼠标左键复制,鼠标右键粘贴"
  372. End If
  373. End Sub
  374. '''//// 标记画框 支持容差 ////'''
  375. Private Sub Mark_CreateRectangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  376. If Button = 2 Then
  377. Tools.Mark_CreateRectangle True
  378. ElseIf Shift = fmCtrlMask Then
  379. Tools.Mark_CreateRectangle False
  380. Else
  381. Create_Tolerance
  382. End If
  383. Speak_Msg "标记画框 右键支持容差"
  384. End Sub
  385. '''//// 一键拆开多行组合的文字字符 ////'''
  386. Private Sub Batch_Combine_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  387. If Button = 2 Then
  388. Tools.Batch_Combine
  389. ElseIf Shift = fmCtrlMask Then
  390. Tools.Take_Apart_Character
  391. Else
  392. Create_Tolerance
  393. End If
  394. Speak_Msg "智能拆字"
  395. End Sub
  396. '''//// 简单一刀切 ////'''
  397. Private Sub Single_Line_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  398. If Button = 2 Then
  399. Tools.Single_Line_Vertical
  400. ElseIf Shift = fmCtrlMask Then
  401. Tools.Single_Line
  402. Else
  403. Tools.Single_Line_LastNode
  404. End If
  405. Speak_Msg "简单一刀切"
  406. End Sub
  407. '''//// 傻瓜火车排列 ////'''
  408. Private Sub TOP_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  409. If Button = 2 Then
  410. Tools.傻瓜火车排列 3#
  411. ElseIf Shift = fmCtrlMask Then
  412. Tools.傻瓜火车排列 0#
  413. Else
  414. Tools.傻瓜火车排列 Set_Space_Width
  415. End If
  416. End Sub
  417. '''//// 傻瓜阶梯排列 ////'''
  418. Private Sub LEFT_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  419. If Button = 2 Then
  420. Tools.傻瓜阶梯排列 3#
  421. ElseIf Shift = fmCtrlMask Then
  422. Tools.傻瓜阶梯排列 0#
  423. Else
  424. Tools.傻瓜阶梯排列 Set_Space_Width
  425. End If
  426. End Sub
  427. '''//// 左键-多页合并一页工具 右键-批量多页居中 ////'''
  428. Private Sub UniteOne_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  429. If Button = 2 Then
  430. Tools.批量多页居中
  431. ElseIf Shift = fmCtrlMask Then
  432. UniteOne.Show 0
  433. Speak_Msg "多页合并一页"
  434. Else
  435. ' Ctrl + 鼠标 空
  436. End If
  437. End Sub
  438. '''//// Adobe AI EPS INDD PDF和CorelDRAW 缩略图工具 ////'''
  439. Private Sub AdobeThumbnail_Click()
  440. Dim h As Long, r As Long
  441. mypath = Path & "GMS\262235.xyz\"
  442. App = mypath & "GuiAdobeThumbnail.exe"
  443. h = FindWindow(vbNullString, "CorelVBA 青年节 By 蘭雅sRGB")
  444. i = ShellExecute(h, "", App, "", mypath, 1)
  445. End Sub
  446. '''//// 快速颜色选择 ////'''
  447. Private Sub Quick_Color_Select_Click()
  448. Tools.quickColorSelect
  449. End Sub
  450. Private Sub Cut_Cake_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  451. If Button = 2 Then
  452. Tools.divideVertically
  453. ElseIf Shift = fmCtrlMask Then
  454. Tools.divideHorizontally
  455. Else
  456. ' Ctrl + 鼠标 空
  457. End If
  458. End Sub
  459. '// 安全辅助线功能,三键控制,讨厌辅助线的也可以用来删除辅助线
  460. Private Sub Safe_Guideangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  461. If Button = 2 Then
  462. Tools.guideangle ActiveSelectionRange, 0# ' 右键0距离贴紧
  463. ElseIf Shift = fmCtrlMask Then
  464. Tools.guideangle ActiveSelectionRange, 3 ' 左键 3mm 出血
  465. Else
  466. Tools.guideangle ActiveSelectionRange, -Set_Space_Width ' Ctrl + 鼠标左键 自定义间隔
  467. End If
  468. End Sub
  469. '// 标准尺寸,左键右键Ctrl三键控制,调用三种样式
  470. Private Sub btn_makesizes_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  471. If Button = 2 Then
  472. Make_SIZE.Show 0 ' 右键
  473. ElseIf Shift = fmCtrlMask Then
  474. #If VBA7 Then
  475. Woodman.Show 0
  476. #Else ' X4 使用
  477. Make_SIZE.Show 0
  478. #End If
  479. Else
  480. Tools.Simple_Label_Numbers ' Ctrl + 鼠标 批量简单数字标注
  481. End If
  482. End Sub
  483. '// 批量转图片和导出图片文件
  484. Private Sub Photo_Form_Click()
  485. PhotoForm.Show 0
  486. End Sub
  487. '// 修复圆角缺角到直角
  488. Private Sub btn_corners_off_Click()
  489. Tools.corner_off
  490. End Sub
  491. Private Sub SortCount_Click()
  492. Tools.按面积排列 30
  493. End Sub
  494. Private Sub LevelRuler_Click()
  495. Tools.角度转平
  496. End Sub
  497. Private Sub MirrorLine_Click()
  498. Tools.参考线镜像
  499. End Sub
  500. Private Sub AutoRotate_Click()
  501. Tools.自动旋转角度
  502. End Sub
  503. Private Sub SwapShape_Click()
  504. Tools.交换对象
  505. End Sub
  506. '// 小工具快速启动
  507. Private Sub Open_Calc_Click()
  508. Launcher.START_Calc
  509. End Sub
  510. Private Sub Open_Notepad_Click()
  511. Launcher.START_Notepad
  512. End Sub
  513. Private Sub ImageReader_Click()
  514. Launcher.START_Barcode_ImageReader
  515. End Sub
  516. Private Sub Video_Camera_Click()
  517. Launcher.START_Bandicam
  518. End Sub
  519. Private Sub myfonts_Click()
  520. Launcher.START_whatthefont
  521. End Sub
  522. Private Sub VectorMagic_Click()
  523. Launcher.START_Vector_Magic
  524. End Sub
  525. Private Sub waifu2x_Click()
  526. Launcher.START_waifu2x
  527. End Sub