蘭雅CorelVBA_五彩斑斓的黑更新_12.16

UI/Toolbar.bas

@@ -4,7 +4,7 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Toolbar
    ClientHeight    =   4230
    ClientLeft      =   45
    ClientTop       =   330
-   ClientWidth     =   6780
+   ClientWidth     =   6840
    OleObjectBlob   =   "Toolbar.frx":0000
 End
 Attribute VB_Name = "Toolbar"
@@ -12,6 +12,7 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+
 #If VBA7 Then
     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
     Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
@@ -65,7 +66,6 @@ Private Sub Change_UI_Close_Voice_Click()
   MsgBox "请给我支持!" & vbNewLine & "您的支持，我才能有动力添加更多功能." & vbNewLine & "蘭雅CorelVBA中秋节版" & vbNewLine & "coreldrawvba插件交流群  8531411"
 End Sub
 
-
 Private Sub UserForm_Initialize()
   Dim IStyle As Long
   Dim hWnd As Long
@@ -129,8 +129,7 @@ End Sub
 
 Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     If Button Then
-        mx = x
-        my = Y
+        mx = x: my = Y
     End If
     
   With Me
@@ -156,8 +155,7 @@ Private Sub LOGO_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVa
     LEFT_ALIGN_BT.Visible = False
     Exit Sub
   ElseIf Shift = fmCtrlMask Then
-      mx = x
-      my = Y
+      mx = x: my = Y
   Else
     Unload Me   ' Ctrl + 鼠标 关闭工具
   End If
@@ -173,65 +171,89 @@ End Sub
 Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
   Dim c As New Color
   ' 定义图标坐标pos
-  Dim pos_x As Variant
-  Dim pos_y As Variant
+  Dim pos_x As Variant, pos_y As Variant
   pos_y = Array(14)
   pos_x = Array(14, 41, 67, 94, 121, 148, 174, 201, 228, 254, 281, 308, 334, 361, 388, 415, 441, 468, 495)
 
-  '// 鼠标右键 扩展键按钮优先  收缩工具栏  标记范围框  居中页面 尺寸取整数  单色黑中线标记 扩展工具栏  排列工具  扩展工具栏收缩
-  If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    Me.Width = 30
-    Me.Height = 30
-    UI.Visible = False
-    LOGO.Visible = True
+  '// 按下Ctrl键，最优先处理工具功能
+  If Shift = 2 Then
+    If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 安全线，清除辅助线
+      Tools.guideangle CorelDRAW.ActiveSelectionRange, 3    ' 左键 3mm 出血
+      
+    ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// Adobe AI EPS INDD PDF和CorelDRAW 缩略图工具
+      AdobeThumbnail_Click
+      
+    ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 多物件拆分线段
+      Tools.Split_Segment
+      
+    ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 智能拆字
+      Tools.Take_Apart_Character
+      
+    ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 暂时空
+      
+    ElseIf Abs(x - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 暂时空
+      
+    ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 暂时空
+      
+    ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// CTRL扩展工具栏
+      Me.Height = 30 + 45
+      
+    End If
     Exit Sub
+  End If
 
-  ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    Tools.居中页面
-    Exit Sub
+  '// 鼠标右键 扩展键按钮优先  收缩工具栏  标记范围框  居中页面 尺寸取整数  单色黑中线标记 扩展工具栏  排列工具  扩展工具栏收缩
+  If Button = 2 Then
+    If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      Me.Width = 30: Me.Height = 30
+      UI.Visible = False: LOGO.Visible = True
 
-  ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    Tools.Mark_Range_Box
-    Exit Sub
+    ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      Tools.居中页面
 
-  ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    Tools.尺寸取整
-    Exit Sub
-  
-  ElseIf Abs(x - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    自动中线色阶条.Auto_ColorMark_K
-    Exit Sub
-  
-  '//分分合合把几个功能按键合并到一起，定义到右键上
-  ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    Tools.分分合合
-    Exit Sub
-  
-  ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    智能群组和查找.智能群组 API.Create_Tolerance
-    Exit Sub
-  
-  ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    '// 右键扩展工具栏
-    Me.Height = 30 + 45
-    Exit Sub
-  
-  ElseIf Abs(x - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    '// 右键拆分线段
-    Tools.Split_Segment
-    Exit Sub
-  
-  ElseIf Abs(x - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    '// 右键排列工具
-    TOP_ALIGN_BT.Visible = True
-    LEFT_ALIGN_BT.Visible = True
-    Exit Sub
+    ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      Tools.Mark_Range_Box
 
-  ElseIf Abs(x - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
-    '// 右键扩展工具栏收缩
-    Me.Height = 30
-    Exit Sub
+    ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      Tools.尺寸取整
+    
+    ElseIf Abs(x - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      自动中线色阶条.Auto_ColorMark_K
+
+    '//分分合合把几个功能按键合并到一起，定义到右键上
+    ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      Tools.分分合合
+
+    ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      智能群组和查找.智能群组 API.Create_Tolerance
+
+    ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 右键扩展工具栏
+      Me.Height = 30 + 45
+      
+    ElseIf Abs(x - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 右键拆分线段
+      Tools.Split_Segment
+
+    ElseIf Abs(x - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 右键排列工具
+      TOP_ALIGN_BT.Visible = True
+      LEFT_ALIGN_BT.Visible = True
 
+    ElseIf Abs(x - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+      '// 右键扩展工具栏收缩
+      Me.Height = 30
+      
+    End If
+    Exit Sub
   End If
   
   '// 鼠标左键 单击按钮功能  按工具栏上图标正常功能
@@ -296,15 +318,13 @@ Private Sub X_EXIT_Click()
   Unload Me    ' 关闭
 End Sub
 
-
-Private Sub 调用多页合并工具()
-  Dim value As Integer
-  value = GMSManager.RunMacro("合并多页工具", "合并多页运行.run")
-End Sub
-
+'// 多页合并工具，已经合并到主线工具
+' Private Sub 调用多页合并工具()
+'  Dim value As Integer
+'  value = GMSManager.RunMacro("合并多页工具", "合并多页运行.run")
+' End Sub
 
 '''///  贪心商人和好玩工具等  ///'''
-
 Private Sub Cdr_Nodes_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
   If Button = 2 Then
     TSP.Nodes_To_TSP
@@ -546,11 +566,11 @@ End Sub
 '// 安全辅助线功能，三键控制，讨厌辅助线的也可以用来删除辅助线
 Private Sub Safe_Guideangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
   If Button = 2 Then
-    Tools.guideangle CorelDRAW.ActiveSelectionRange, 0#   ' 右键 0距离贴紧
+    Tools.guideangle CorelDRAW.ActiveSelectionRange, 0#   ' 右键0距离贴紧
   ElseIf Shift = fmCtrlMask Then
-    Tools.guideangle CorelDRAW.ActiveSelectionRange, 4    ' 左键安全范围 4mm
+    Tools.guideangle CorelDRAW.ActiveSelectionRange, 3    ' 左键 3mm 出血
   Else
-    Tools.guideangle CorelDRAW.ActiveSelectionRange, -Set_Space_Width     ' Ctrl + 鼠标左键
+    Tools.guideangle CorelDRAW.ActiveSelectionRange, -Set_Space_Width     ' Ctrl + 鼠标左键 自定义间隔
   End If
 End Sub
 
@@ -564,11 +584,22 @@ Private Sub Open_Notepad_Click()
   Launcher.START_Notepad
 End Sub
 
-Private Sub terminal_Click()
-  Launcher.START_GitBash
+Private Sub ImageReader_Click()
+  Launcher.START_Barcode_ImageReader
 End Sub
 
 Private Sub Video_Camera_Click()
   Launcher.START_Bandicam
 End Sub
 
+Private Sub myfonts_Click()
+  Launcher.START_whatthefont
+End Sub
+
+Private Sub VectorMagic_Click()
+  Launcher.START_Vector_Magic
+End Sub
+
+Private Sub waifu2x_Click()
+  Launcher.START_waifu2x
+End Sub

donate.md

@@ -38,6 +38,7 @@ zdj168
 99彩印
 JZ捷众广告
 醉后的最后
+骑着"蜗牛"撵娘们
 ```
 
 ### 会员群福利: 

module/Launcher.bas

@@ -12,16 +12,37 @@ Public Function START_Notepad()
 End Function
 
 
-'// 记事本打开备忘录
-Public Function START_GitBash()
-    cmd_line = "cmd"
+'// 打开条码阅读器
+Public Function START_Barcode_ImageReader()
+    cmd_line = "C:\Program Files (x86)\Softek Software\Softek Barcode Toolkit 30 Day Evaluation\bin\ImageReader.exe"
     Shell cmd_line, vbNormalNoFocus
 End Function
 
 
-'// 记事本打开备忘录
+'// 矢量化工具 Vector Magic
+Public Function START_Vector_Magic()
+    cmd_line = "C:\Program Files (x86)\Vector Magic\vmde.exe"
+    Shell cmd_line, vbNormalNoFocus
+End Function
+
+'// waifu2x 图片放大
+Public Function START_waifu2x()
+    cmd_line = "C:\soft\waifu2x-gui-1.2\waifu2x-gui.exe"
+    Shell cmd_line, vbNormalNoFocus
+End Function
+
+'// 开始视频录制
 Public Function START_Bandicam()
     cmd_line = "C:\Program Files (x86)\Bandicam\BandicamPortable.exe"
     Shell cmd_line, vbNormalNoFocus
 End Function
 
+'// 找字体 https://www.myfonts.com/pages/whatthefont
+Public Function START_whatthefont()
+    Weburl "https://www.myfonts.com/pages/whatthefont"
+End Function
+
+
+Function Weburl(url As String)
+  CorelVBA.WebHelp url
+End Function

module/Tools.bas

@@ -834,8 +834,6 @@ Public Function guideangle(actnumber As ShapeRange, cardblood As Integer)
   If 0 = ActiveSelectionRange.Count Then Exit Function
   ActiveDocument.Unit = cdrMillimeter
 
-
-
   With actnumber
     Set s1 = ActiveDocument.MasterPage.GuidesLayer.CreateGuideAngle(0, .TopY - cardblood, 0#)
     Set s1 = ActiveDocument.MasterPage.GuidesLayer.CreateGuideAngle(0, .BottomY + cardblood, 0#)
@@ -843,7 +841,5 @@ Public Function guideangle(actnumber As ShapeRange, cardblood As Integer)
     Set s1 = ActiveDocument.MasterPage.GuidesLayer.CreateGuideAngle(.RightX - cardblood, 0, 90#)
   End With
   
-
-
 End Function