一刀切升级，Python工具源码加入

README.md

@@ -2,6 +2,19 @@
 # [CorelDRAW VBA](https://262235.xyz/index.php/tag/vba/)
 ![](https://262235.xyz/usr/uploads/2022/03/525753621.webp)
 
+## 蘭雅CorelVBA工具中秋预览版 [安装视频点击](https://262235.xyz/CorelVBA/install.mp4)
+- 以 CorelDRAW X6 举例
+### 1. 解压压缩包 蘭雅CorelVBA工具中秋预览版.7z
+### 2. 找到 X6的 GMS目录，把GMS目录下文件 复制粘贴替换
+### 3. 开启CorelDRAW软件，导入 蘭雅CorelVBA工具栏
+   X6     选  蘭雅sRGB工具_导入CorelDRAW_X6.xslt
+   高版本 选  蘭雅sRGB工具_导入CorelDRAW_2018_2022.cdws
+   X4     选  蘭雅sRGB工具_导入CorelDRAW_X4.xslt
+
+### 4. 导入后，右键打开工具栏，点击 `蘭` 图标 开始
+
+使用相关文章   https://262235.xyz/index.php/tag/vba/
+
 # [蘭雅CorelVBA工具-中秋版 将奉送价值上千多款定置插件](https://262235.xyz/index.php/archives/1124/)
 
 ## 蘭雅CorelVBA工具中秋版 修复更新和添加的主要功能

UI/Toolbar.bas

@@ -12,6 +12,8 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+
+
 #If VBA7 Then
     Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
     Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
@@ -20,9 +22,9 @@ Attribute VB_Exposed = False
     Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
     
 #Else
-    Private Declare Function DrawMenuBar Lib "user32" (ByVal Hwnd As Long) As Long
-    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
-    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
+    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
+    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
+    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
     Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
 #End If
@@ -34,7 +36,7 @@ Private Const WS_EX_DLGMODALFRAME = &H1&
 Public UIL_Key As Boolean
 Public pic1, pic2
 
-Private Sub CommandButton3_Click()
+Private Sub Change_UI_Close_Voice_Click()
   Speak_Msg "修改UI图片更换界面  注册表关闭语音 详QQ群"
   MsgBox "请给我支持!" & vbNewLine & "您的支持，我才能有动力添加更多功能." & vbNewLine & "蘭雅CorelVBA中秋节版" & vbNewLine & "coreldrawvba插件交流群  8531411"
 End Sub
@@ -89,7 +91,7 @@ Private Sub UI_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal
   ElseIf Y > 16 And UIL_Key Then
     UI.Picture = pic1
   End If
-    UI.Visible = True
+  UI.Visible = True
 
   ' Debug.Print X & " , " & Y
 End Sub
@@ -286,22 +288,23 @@ End Sub
 
 
 Private Sub BITMAP_MAKE_DOTS_Click()
+  Tools.Python_BITMAP
   TSP.BITMAP_MAKE_DOTS
 End Sub
 
 
 Private Sub CBPY01_Click()
-  Tools.Python脚本整理尺寸
+  Tools.Python_Organize_Size
   Me.Height = 30
 End Sub
 
 Private Sub CBPY02_Click()
-  Tools.Python提取条码数字
+  Tools.Python_Get_Barcode_Number
   Me.Height = 30
 End Sub
 
 Private Sub CBPY03_Click()
-  Tools.Python二维码QRCode
+  Tools.Python_Make_QRCode
   Tools.QRCode_replace
 End Sub
 
@@ -399,11 +402,11 @@ End Sub
 '''////  简单一刀切  ////'''
 Private Sub Single_Line_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
-    Me.Height = 30
+    Tools.Single_Line_Vertical
   ElseIf Shift = fmCtrlMask Then
     Tools.Single_Line
   Else
-    ' Ctrl + 鼠标  空
+    Tools.Single_Line_LastNode
   End If
   
   Speak_Msg "简单一刀切"

donate.md

@@ -24,6 +24,9 @@
 鹏阳图文广告(靓仔)
 [%ĀĀÙ]客服中心
 溜溜
+A
+顶天办公
+大白
 ```
 
 ### 会员群福利: 

module/Tools.bas

@@ -178,20 +178,27 @@ Public Function 居中页面()
 End Function
 
 
-Public Function Python脚本整理尺寸()
-    mypy = Path & "GMS\262235.xyz\整理尺寸.py"
+'''///  使用Python脚本 整理尺寸 提取条码数字 建立二维码 位图转文本 ///'''
+Public Function Python_Organize_Size()
+    mypy = Path & "GMS\262235.xyz\Organize_Size.py"
     cmd_line = "pythonw " & Chr(34) & mypy & Chr(34)
     Shell cmd_line
 End Function
 
-Public Function Python提取条码数字()
-    mypy = Path & "GMS\262235.xyz\提取条码数字.py"
+Public Function Python_Get_Barcode_Number()
+    mypy = Path & "GMS\262235.xyz\Get_Barcode_Number.py"
     cmd_line = "pythonw " & Chr(34) & mypy & Chr(34)
     Shell cmd_line
 End Function
 
-Public Function Python二维码QRCode()
-    mypy = Path & "GMS\262235.xyz\二维码QRCode.py"
+Public Function Python_BITMAP()
+    mypy = Path & "GMS\262235.xyz\BITMAP.py"
+    cmd_line = "pythonw " & Chr(34) & mypy & Chr(34)
+    Shell cmd_line
+End Function
+
+Public Function Python_Make_QRCode()
+    mypy = Path & "GMS\262235.xyz\Make_QRCode.py.py"
     cmd_line = "pythonw " & Chr(34) & mypy & Chr(34)
     Shell cmd_line
 End Function
@@ -442,8 +449,8 @@ End Function
 '''//// 简单一刀切 识别群组 ////''' ''' 本功能由群友宏瑞广告赞助发行 '''
 Public Function Single_Line()
   If 0 = ActiveSelectionRange.Count Then Exit Function
-'  On Error GoTo ErrorHandler
-'  ActiveDocument.BeginCommandGroup:  Application.Optimization = True
+  On Error GoTo ErrorHandler
+  ActiveDocument.BeginCommandGroup:  Application.Optimization = True
   ActiveDocument.Unit = cdrMillimeter
   
   Dim cm(2)  As Color
@@ -503,7 +510,127 @@ ErrorHandler:
   On Error Resume Next
 End Function
 
+Public Function Single_Line_Vertical()
+  If 0 = ActiveSelectionRange.Count Then Exit Function
+  On Error GoTo ErrorHandler
+  ActiveDocument.BeginCommandGroup:  Application.Optimization = True
+  ActiveDocument.Unit = cdrMillimeter
+  
+  Dim cm(2)  As Color
+  Set cm(0) = CreateRGBColor(0, 255, 0) ' RGB 绿
+  Set cm(1) = CreateRGBColor(255, 0, 0) ' RGB 红
+
+  Dim ssr As ShapeRange
+  Dim SrNew As New ShapeRange
+  Dim s As Shape, s1 As Shape, line As Shape, line2 As Shape
+  Dim cnt As Integer
+  cnt = 1
+  
+
+  If 1 = ActiveSelectionRange.Count Then
+    Set ssr = ActiveSelectionRange(1).UngroupAllEx
+  Else
+    Set ssr = ActiveSelectionRange
+  End If
+    
+  ' 记忆选择范围
+  Dim X As Double, Y As Double, w As Double, h As Double
+
+  ssr.GetBoundingBox X, Y, w, h
+  Set s1 = ActiveLayer.CreateRectangle2(X, Y, w, h)
+  s1.Outline.SetProperties Color:=cm(0)
+  SrNew.Add s1
+  
+#If VBA7 Then
+  ssr.Sort " @shape1.top>@shape2.top"
+#Else
+' X4 不支持 ShapeRange.sort
+#End If
+
+  For Each s In ssr
+    If cnt > 1 Then
+      s.ConvertToCurves
+      Set line = ActiveLayer.CreateLineSegment(s.LeftX, s.TopY, s.RightX, s.TopY)
+      line.Outline.SetProperties Color:=cm(1)
+      SrNew.Add line
+    End If
+    cnt = cnt + 1
+  Next s
+  
+  SrNew.Group
+  
+  ActiveDocument.EndCommandGroup
+  Application.Optimization = False
+  ActiveWindow.Refresh:    Application.Refresh
+  
+Exit Function
+ErrorHandler:
+  Application.Optimization = False
+  On Error Resume Next
+End Function
+
+Public Function Single_Line_LastNode()
+  If 0 = ActiveSelectionRange.Count Then Exit Function
+'  On Error GoTo ErrorHandler
+'  ActiveDocument.BeginCommandGroup:  Application.Optimization = True
+  ActiveDocument.Unit = cdrMillimeter
+  
+  Dim cm(2)  As Color
+  Set cm(0) = CreateRGBColor(0, 255, 0) ' RGB 绿
+  Set cm(1) = CreateRGBColor(255, 0, 0) ' RGB 红
+
+  Dim ssr As ShapeRange
+  Dim SrNew As New ShapeRange
+  Dim s As Shape, s1 As Shape, line As Shape, line2 As Shape
+  Dim cnt As Integer
+  cnt = 1
+  
+
+  If 1 = ActiveSelectionRange.Count Then
+    Set ssr = ActiveSelectionRange(1).UngroupAllEx
+  Else
+    Set ssr = ActiveSelectionRange
+  End If
+    
+  ' 记忆选择范围
+  Dim X As Double, Y As Double, w As Double, h As Double
+
+  ssr.GetBoundingBox X, Y, w, h
+  Set s1 = ActiveLayer.CreateRectangle2(X, Y, w, h)
+  s1.Outline.SetProperties Color:=cm(0)
+  SrNew.Add s1
+  
+#If VBA7 Then
+  ssr.Sort " @shape1.left<@shape2.left"
+#Else
+' X4 不支持 ShapeRange.sort
+#End If
+
+  Dim nr As NodeRange
+  For Each s In ssr
+    If cnt > 1 Then
+      Set nr = s.DisplayCurve.Nodes.All
+      Set line = ActiveLayer.CreateLineSegment(nr.FirstNode.PositionX, nr.FirstNode.PositionY, nr.LastNode.PositionX, nr.LastNode.PositionY)
+      line.Outline.SetProperties Color:=cm(1)
+      SrNew.Add line
+    End If
+    cnt = cnt + 1
+  Next s
+  
+  SrNew.Group
+  
+  ActiveDocument.EndCommandGroup
+  Application.Optimization = False
+  ActiveWindow.Refresh:    Application.Refresh
+  
+Exit Function
+ErrorHandler:
+  Application.Optimization = False
+  On Error Resume Next
+End Function
+
 
+'''//// 选择范围画框 ////'''
 Public Function Mark_Range_Box()
   If 0 = ActiveSelectionRange.Count Then Exit Function
   ActiveDocument.Unit = cdrMillimeter

python/BITMAP.py

@@ -0,0 +1,27 @@
+from array import array
+import numpy as np
+import cv2 as cv
+
+# 加载图片到灰度图像
+img = cv.imread('C:\TSP\png.png', cv.IMREAD_GRAYSCALE)
+h,w = img.shape
+print(h,w)
+print(img.size)
+
+f = open('C:\TSP\BITMAP', 'w')
+line = '%d %d %d\n' % (h,w, img.size)
+f.write(line)
+
+lst = ['0'] * w
+for m in range(h):
+    for n in range(w):
+        if img[m,n] == 0:
+            lst[n] = '1'
+        else:
+            lst[n] = '0'
+    line = ' '.join(lst)
+    f.write(line+'\n')
+
+# cv.imshow('image',img)
+# cv.waitKey(5000)
+# cv.destroyAllWindows()

python/Get_Barcode_Number.py

@@ -0,0 +1,28 @@
+# python 读写剪切板内容, 先用下行命令安装运行库
+# python -m pip install pywin32
+
+import win32clipboard as w
+import win32con
+import re
+
+def getText():
+    w.OpenClipboard()
+    d = w.GetClipboardData(win32con.CF_TEXT)
+    w.CloseClipboard()
+    return(d).decode('GBK')
+
+def setText(aString):
+    w.OpenClipboard()
+    w.EmptyClipboard()
+    w.SetClipboardText(aString)
+    w.CloseClipboard()
+
+text = getText()
+
+# 修改一行 编程提取条码数字
+list = re.findall(r"\d{12,14}", text)
+if len(list) == 0 :
+    list = re.findall(r"X00[0-9a-zA-Z]+", text)
+text = "\n".join(list)
+setText(text)
+print(text)

python/Make_QRCode.py

@@ -0,0 +1,21 @@
+# 输入命令安装所需库  python -m pip install pywin32 qrcode
+import win32clipboard as w
+import win32con, qrcode, sys
+
+def getText():
+    w.OpenClipboard()
+    d = w.GetClipboardData(win32con.CF_TEXT)
+    w.CloseClipboard()
+    return(d).decode('GBK')
+
+def setText(aString):
+    w.OpenClipboard()
+    w.EmptyClipboard()
+    w.SetClipboardText(aString)
+    w.CloseClipboard()
+
+text = getText()   # 从剪贴板得到文字
+img = qrcode.make(text)  # 把文字转成图片
+qrcode_file = sys.path[0] + '\\qrcode.png'   # 组合保存结果的文件名
+img.save(qrcode_file)   # 把图片保存成文件
+setText(qrcode_file)   # 把文件名写到剪贴板

base/提取剪切板尺寸数字.py → python/Organize_Size.py

@@ -1,54 +1,54 @@
-# python 读写剪切板内容, 先用下行命令安装运行库
-# python -m pip install pywin32
-
-import win32clipboard as w
-import win32con
-import re
-
-def getText():
-    w.OpenClipboard()
-    d = w.GetClipboardData(win32con.CF_TEXT)
-    w.CloseClipboard()
-    return(d).decode('GBK')
-
-def setText(aString):
-    w.OpenClipboard()
-    w.EmptyClipboard()
-    w.SetClipboardText(aString)
-    w.CloseClipboard()
-
-def list_to_clipboard(list):
-    text = " ".join(list)
-    print(text)
-    setText(text)
-
-# 单位in或cm 换算mm
-def convert_mm(text, unit):
-    list = re.findall(r"[1-9][\d\.]*\d*", text)
-    if (unit == 'in') :
-        print("单位英寸")
-        for i, ch in enumerate(list):
-            list[i] = str((int(float(ch) * 25.4 + 0.5)))
-    elif(unit == 'cm')  :
-        print("单位厘米")
-        for i, ch in enumerate(list):
-             list[i] = str((int(float(ch) * 10 + 0.5)))         
-    list_to_clipboard(list)
-
-# 获取剪贴板文本
-text = getText()
-# print(text)
-
-# 正则搜索数字，写回剪贴板
-list = re.findall(r"[1-9][\d\.]*\d*[cmin\"]*", text)
-list_to_clipboard(list)
-
-# 判断厘米和英寸换算mm
-match  = re.search(r"cm|in|\"", text)
-if match:
-    # print(match.group())
-    unit = match.group()
-    if (unit == 'in') or (unit == '\"') :
-        convert_mm(text, 'in')
-    elif(unit == 'cm')  :
-        convert_mm(text, 'cm')
+# python 读写剪切板内容, 先用下行命令安装运行库
+# python -m pip install pywin32
+
+import win32clipboard as w
+import win32con
+import re
+
+def getText():
+    w.OpenClipboard()
+    d = w.GetClipboardData(win32con.CF_TEXT)
+    w.CloseClipboard()
+    return(d).decode('GBK')
+
+def setText(aString):
+    w.OpenClipboard()
+    w.EmptyClipboard()
+    w.SetClipboardText(aString)
+    w.CloseClipboard()
+
+def list_to_clipboard(list):
+    text = " ".join(list)
+    print(text)
+    setText(text)
+
+# 单位in或cm 换算mm
+def convert_mm(text, unit):
+    list = re.findall(r"[1-9][\d\.]*\d*", text)
+    if (unit == 'in') :
+        print("单位英寸")
+        for i, ch in enumerate(list):
+            list[i] = str((int(float(ch) * 25.4 + 0.5)))
+    elif(unit == 'cm')  :
+        print("单位厘米")
+        for i, ch in enumerate(list):
+             list[i] = str((int(float(ch) * 10 + 0.5)))         
+    list_to_clipboard(list)
+
+# 获取剪贴板文本
+text = getText()
+# print(text)
+
+# 正则搜索数字，写回剪贴板
+list = re.findall(r"[1-9][\d\.]*\d*[cmin\"]*", text)
+list_to_clipboard(list)
+
+# 判断厘米和英寸换算mm
+match  = re.search(r"cm|in|\"", text)
+if match:
+    # print(match.group())
+    unit = match.group()
+    if (unit == 'in') or (unit == '\"') :
+        convert_mm(text, 'in')
+    elif(unit == 'cm')  :
+        convert_mm(text, 'cm')