1
1

Toolbar.frm 22 KB

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