1
1

Toolbar.frm 22 KB

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