1
1

Toolbar.bas 22 KB

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