2023.7.28 The multi-language conversion library has been preliminarily completed and started testing

UI/Toolbar.bas

@@ -13,7 +13,6 @@ Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 
-
 '// This is free and unencumbered software released into the public domain.
 '// For more information, please refer to  https://github.com/hongwenjun
 
@@ -29,13 +28,13 @@ Private Const Github_Version = 1
     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
     
 #Else
-    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
-    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 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 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
-    Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
+    Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
 #End If
 
 Private Const GWL_STYLE As Long = (-16)
@@ -70,7 +69,18 @@ End Sub
 
 Private Sub Change_UI_Close_Voice_Click()
   SaveSetting "LYVBA", "Settings", "SpeakHelp", "0"
-  MsgBox "请给我支持!" & vbNewLine & "您的支持，我才能有动力添加更多功能." & vbNewLine & "蘭雅CorelVBA工具 永久免费开源" & vbNewLine & "主题图片文件名ToolBar.jpg 安装包中有多套皮肤选用"
+  MsgBox "请给我支持!" & vbNewLine & "您的支持，我才能有动力添加更多功能." & vbNewLine & "蘭雅CorelVBA工具 永久免费开源"
+End Sub
+
+Private Sub I18N_LNG_Click()
+  LNG_CODE = Val(GetSetting("LYVBA", "Settings", "I18N_LNG", "1033"))
+  If LNG_CODE = 1033 Then
+    LNG_CODE = 2052
+  Else
+    LNG_CODE = 1033
+  End If
+  SaveSetting "LYVBA", "Settings", "I18N_LNG", LNG_CODE
+  MsgBox "中英文语言切换完成，请重启插件!", vbOKOnly, "兰雅VBA代码分享"
 End Sub
 
 Private Sub UserForm_Initialize()
@@ -261,7 +271,7 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
       
     ElseIf Abs(x - pos_x(7)) < 14 And Abs(Y - pos_y(0)) < 14 Then
      '// 选择相同工具增强版
-      frmSelectSame.show 0
+      frmSelectSame.Show 0
 
     ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
       '// 右键扩展工具栏
@@ -295,7 +305,7 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
     
   ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     If Github_Version = 1 Then
-      Woodman.show 0
+      Woodman.Show 0
     Else
       '// 单线条转裁切线 - 放置到页面四边
       CutLines.SelectLine_to_Cropline
@@ -317,10 +327,10 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
     SmartGroup.Smart_Group
     
   ElseIf Abs(x - pos_x(7)) < 14 And Abs(Y - pos_y(0)) < 14 Then
-    CQL_FIND_UI.show 0
+    CQL_FIND_UI.Show 0
     
   ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
-    Replace_UI.show 0
+    Replace_UI.Show 0
     
   ElseIf Abs(x - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     ' 简单文本转曲
@@ -464,22 +474,10 @@ End Sub
 
 Private Sub Tools_Icon_Click()
   ' 调用语句
-  i = GMSManager.RunMacro("CorelDRAW_VBA", "学习CorelVBA.start")
+  i = GMSManager.RunMacro("ZeroBase", "Hello_VBA.run")
 End Sub
 
-'''////  选择多物件，组合然后拆分线段，为角线爬虫准备  ////'''
 Private Sub Split_Segment_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
-  If Button = 2 Then
-    MsgBox "鼠标右键，功能待定"
-    Exit Sub
-  End If
-  
-  If Button Then
-      Tools.Split_Segment
-  End If
-End Sub
-
-Private Sub Split_Segment_Copy_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
   If Button = 2 Then
     MsgBox "左键拆分线段，Ctrl合并线段"
   ElseIf Shift = fmCtrlMask Then
@@ -568,7 +566,7 @@ Private Sub UniteOne_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Intege
   If Button = 2 Then
     Tools.Batch_Align_Page_Center
   ElseIf Shift = fmCtrlMask Then
-    UniteOne.show 0
+    UniteOne.Show 0
   Else
     ' Ctrl + 鼠标  空
   End If
@@ -613,12 +611,12 @@ End Sub
 '// 标准尺寸，左键右键Ctrl三键控制，调用三种样式
 Private Sub btn_makesizes_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
   If Button = 2 Then
-    Make_SIZE.show 0   ' 右键
+    Make_SIZE.Show 0   ' 右键
   ElseIf Shift = fmCtrlMask Then
     #If VBA7 Then
-      Woodman.show 0
+      Woodman.Show 0
     #Else  ' X4 使用
-      Make_SIZE.show 0
+      Make_SIZE.Show 0
     #End If
   Else
     Tools.Simple_Label_Numbers  ' Ctrl + 鼠标  批量简单数字标注
@@ -627,7 +625,7 @@ End Sub
 
 '// 批量转图片和导出图片文件
 Private Sub Photo_Form_Click()
-  PhotoForm.show 0
+  PhotoForm.Show 0
 End Sub
 
 '// 修复圆角缺角到直角

UI/Woodman.bas

@@ -13,20 +13,21 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+
 '// This is free and unencumbered software released into the public domain.
 '// For more information, please refer to  https://github.com/hongwenjun
 
 #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
-    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
+    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
+    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
     Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     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
@@ -39,18 +40,18 @@ Private Const WS_EX_DLGMODALFRAME = &H1&
 Private Function MiniForm()
 
   Dim IStyle As Long
-  Dim hWnd As Long
+  Dim hwnd As Long
   
-  hWnd = FindWindow("ThunderDFrame", Woodman.Caption)
+  hwnd = FindWindow("ThunderDFrame", Woodman.Caption)
 
-  IStyle = GetWindowLong(hWnd, GWL_STYLE)
+  IStyle = GetWindowLong(hwnd, GWL_STYLE)
   IStyle = IStyle And Not WS_CAPTION
-  SetWindowLong hWnd, GWL_STYLE, IStyle
-  DrawMenuBar hWnd
-  IStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
-  SetWindowLong hWnd, GWL_EXSTYLE, IStyle
+  SetWindowLong hwnd, GWL_STYLE, IStyle
+  DrawMenuBar hwnd
+  IStyle = GetWindowLong(hwnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
+  SetWindowLong hwnd, GWL_EXSTYLE, IStyle
 
-' Dim ctl As Control  '// CorelDRAW 2020 需要注释，才不会错误
+  Dim ctl As Variant  '// CorelDRAW 2020 定义成 Variant 才不会错误
   For Each ctl In Woodman.Controls
       ctl.Visible = False
       ctl.Top = 2
@@ -62,7 +63,7 @@ Private Function MiniForm()
     .Left = Val(GetSetting("LYVBA", "Settings", "Left", "400")) + 318
     .Top = Val(GetSetting("LYVBA", "Settings", "Top", "55")) - 2
     .Height = 28
-    .Width = 98
+    .width = 98
     
     .MarkLines_Makesize.Visible = True
     .btn_Makesizes.Visible = True
@@ -82,76 +83,71 @@ Private Sub btn_MiniForm_Click()
   MiniForm
 End Sub
 
+Private Sub UserForm_Initialize()
+  LNG_CODE = Val(GetSetting("LYVBA", "Settings", "I18N_LNG", "1033"))
+  Init_Translations Me, LNG_CODE
+  Me.Caption = i18n("Batch Dimension Nodes", LNG_CODE)
+End Sub
+
 Private Sub btn_square_hi_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
-    ActiveDocument.BeginCommandGroup:  Application.Optimization = True
-    Set os = ActiveSelectionRange
-    Set ss = os.Shapes
-    uc = 0
-    For Each s In ss
-        s.SizeWidth = s.SizeHeight
-        uc = uc + 1
-    Next s
-    Application.Optimization = False
-    ActiveWindow.Refresh:    Application.Refresh
+  API.BeginOpt
+  Set os = ActiveSelectionRange
+  Set ss = os.Shapes
+  For Each s In ss
+    s.SizeWidth = s.SizeHeight
+  Next s
+  API.EndOpt
 End Sub
 
 
 Private Sub btn_square_wi_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
-    ActiveDocument.BeginCommandGroup:  Application.Optimization = True
-    Set os = ActiveSelectionRange
-    Set ss = os.Shapes
-    uc = 0
-    For Each s In ss
-        s.SizeHeight = s.SizeWidth
-        uc = uc + 1
-    Next s
-    Application.Optimization = False
-    ActiveWindow.Refresh:    Application.Refresh
+  API.BeginOpt
+  Set os = ActiveSelectionRange
+  Set ss = os.Shapes
+  For Each s In ss
+    s.SizeHeight = s.SizeWidth
+  Next s
+  API.EndOpt
 End Sub
 
 Private Sub btn_Makesizes_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
-    Dim os As ShapeRange
-    Dim s As Shape
-    Dim sr As ShapeRange
-    Set doc = ActiveDocument
+  On Error GoTo ErrorHandler
+  API.BeginOpt
+  Dim os As ShapeRange
+  Dim s As Shape
+  Dim sr As ShapeRange
+  Set doc = ActiveDocument
+  Set sr = ActiveSelectionRange
+  sr.RemoveAll
     
-'rasm.Dimension.TextShape.Text.Story.size = CLng(fnt)
-'rasm.Style.GetProperty("dimension").SetProperty "precision", 0
-'rasm.Style.GetProperty("dimension").SetProperty "units", 3
+  If Shift = 4 Then
+    Set os = ActiveSelectionRange
+    For Each s In os.Shapes
+      If s.Type = cdrLinearDimensionShape Then s.Delete
+    Next s
     
-    doc.BeginCommandGroup "delete sizes"
-        Set sr = ActiveSelectionRange
-        sr.RemoveAll
-    If Shift = 4 Then
-        On Error Resume Next
-        Set os = ActiveSelectionRange
-        For Each s In os.Shapes
-            If s.Type = cdrLinearDimensionShape Then s.Delete
-        Next s
-        On Error GoTo 0
-    ElseIf Shift = 1 Then
-        Set os = ActiveSelectionRange
-        For Each s In os.Shapes
-            If s.Type = cdrLinearDimensionShape Then sr.Add s
-        Next s
-        sr.CreateSelection
-        On Error GoTo 0
-    ElseIf Shift = 2 Then
-        On Error Resume Next
-        Set os = ActiveSelectionRange
-        For Each s In os.Shapes
-            If s.Type = cdrLinearDimensionShape Then s.Delete
-        Next s
-          If os.Count > 0 Then
-            os.Shapes.FindShapes(Query:="@name ='DMKLine'").CreateSelection
-            ActiveSelectionRange.Delete
-          End If
-        On Error GoTo 0
-    Else
-        make_sizes Shift
-    End If
-    doc.EndCommandGroup
-    Application.Refresh
+  ElseIf Shift = 1 Then
+    Set os = ActiveSelectionRange
+    For Each s In os.Shapes
+      If s.Type = cdrLinearDimensionShape Then sr.Add s
+    Next s
+    sr.CreateSelection
+    
+  ElseIf Shift = 2 Then
+    Set os = ActiveSelectionRange
+    For Each s In os.Shapes
+      If s.Type = cdrLinearDimensionShape Then s.Delete
+    Next s
+      If os.Count > 0 Then
+        os.Shapes.FindShapes(Query:="@name ='DMKLine'").CreateSelection
+        ActiveSelectionRange.Delete
+      End If
+  Else
+    make_sizes Shift
+  End If
+  
+ErrorHandler:
+  API.EndOpt
 End Sub
 
 Private Sub btn_sizes_up_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
@@ -183,140 +179,162 @@ End Sub
 Sub make_sizes_sep(dr, Optional shft = 0, Optional ByVal mirror As Boolean = False)
   On Error GoTo ErrorHandler
   API.BeginOpt "Make Size"
-    Set doc = ActiveDocument
-    Dim s As Shape, sh As Shape
-    Dim pts As New SnapPoint, pte As New SnapPoint
-    Dim os As ShapeRange
-    
-    Set os = ActiveSelectionRange
-    
-    Dim border As Variant
-    Dim Line_len As Double
-    If shft > 1 Then
-        Line_len = API.Set_Space_Width   '// 设置文字空间间隙
-    Else
-        Line_len = API.Set_Space_Width(True)    '// 只读文字空间间隙
-    End If
-    
-    border = Array(cdrBottomRight, cdrBottomLeft, os.TopY + Line_len, os.TopY + 2 * Line_len, _
-                    cdrBottomRight, cdrTopRight, os.LeftX - Line_len, os.LeftX - 2 * Line_len)
-                    
-    If mirror = True Then border = Array(cdrTopRight, cdrTopLeft, os.BottomY - Line_len, os.BottomY - 2 * Line_len, _
-                            cdrBottomLeft, cdrTopLeft, os.RightX + Line_len, os.RightX + 2 * Line_len)
-   
-        
-    If dr = "upbx" Or dr = "upb" Or dr = "dnb" Or dr = "up" Or dr = "dn" Then os.Sort "@shape1.left < @shape2.left"
-    If dr = "lfbx" Or dr = "lfb" Or dr = "rib" Or dr = "lf" Or dr = "ri" Then os.Sort "@shape1.top > @shape2.top"
-    
-    If os.Count > 0 Then
-        If os.Count > 1 And Len(dr) > 2 And os.Shapes.Count > 1 Then
-            For i = 1 To os.Shapes.Count - 1
-                Select Case dr
-                    Case "upbx":
-                          Set pts = os.Shapes(i).SnapPoints.BBox(border(0))
-                          Set pte = os.Shapes(i + 1).SnapPoints.BBox(border(1))
-                          Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, 0, border(2), cdrDimensionStyleEngineering)
-
-                          If shft > 0 And i = 1 Then
-                            Dimension_SetProperty sh, PresetProperty.value
-                            Set pts = os.FirstShape.SnapPoints.BBox(border(0))
-                            Set pte = os.LastShape.SnapPoints.BBox(border(1))
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, 0, border(3), cdrDimensionStyleEngineering)
-                          End If
-
-                    Case "lfbx":
-                          Set pts = os.Shapes(i).SnapPoints.BBox(border(4))
-                          Set pte = os.Shapes(i + 1).SnapPoints.BBox(border(5))
-                          Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, border(6), 0, cdrDimensionStyleEngineering)
+  Set doc = ActiveDocument
+  Dim s As Shape, sh As Shape
+  Dim pts As New SnapPoint, pte As New SnapPoint
+  Dim os As ShapeRange
   
-                          If shft > 0 And i = 1 Then
-                            Dimension_SetProperty sh, PresetProperty.value
-                            Set pts = os.FirstShape.SnapPoints.BBox(border(4))
-                            Set pte = os.LastShape.SnapPoints.BBox(border(5))
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, border(7), 0, cdrDimensionStyleEngineering)
-                          End If
-                          
-                    Case "upb":
-                            Set pts = os.Shapes(i).SnapPoints.BBox(cdrTopRight)
-                            Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrTopLeft)
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.TopY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
-
-                    Case "dnb":
-                            Set pts = os.Shapes(i).SnapPoints.BBox(cdrBottomRight)
-                            Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrBottomLeft)
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.BottomY - os.SizeHeight / 10, cdrDimensionStyleEngineering)
-                    
-                    Case "lfb":
-                            Set pts = os.Shapes(i).SnapPoints.BBox(cdrBottomLeft)
-                            Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrTopLeft)
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.LeftX - os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
-                    
-                    Case "rib":
-                            Set pts = os.Shapes(i).SnapPoints.BBox(cdrBottomRight)
-                            Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrTopRight)
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.RightX + os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
-                End Select
-                '// 尺寸标注设置属性
-                Dimension_SetProperty sh, PresetProperty.value
-                'ActiveDocument.ClearSelection
-            Next i
-        Else
-            If shft > 0 Then
-                Select Case dr
-                    Case "up":
-                            Set pts = os.FirstShape.SnapPoints.BBox(cdrTopLeft)
-                            Set pte = os.LastShape.SnapPoints.BBox(cdrTopRight)
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.TopY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
-                    
-                    Case "dn":
-                            Set pts = os.FirstShape.SnapPoints.BBox(cdrBottomLeft)
-                            Set pte = os.LastShape.SnapPoints.BBox(cdrBottomRight)
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.BottomY - os.SizeHeight / 10, cdrDimensionStyleEngineering)
-                    Case "lf":
-                            Set pts = os.FirstShape.SnapPoints.BBox(cdrTopLeft)
-                            Set pte = os.LastShape.SnapPoints.BBox(cdrBottomLeft)
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.LeftX - os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
-                    Case "ri":
-                            Set pts = os.FirstShape.SnapPoints.BBox(cdrTopRight)
-                            Set pte = os.LastShape.SnapPoints.BBox(cdrBottomRight)
-                            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.RightX + os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
-                End Select
-                Dimension_SetProperty sh, PresetProperty.value
-            Else
-                For Each s In os.Shapes
-                    Select Case dr
-                        Case "up":
-                                Set pts = s.SnapPoints.BBox(cdrTopLeft)
-                                Set pte = s.SnapPoints.BBox(cdrTopRight)
-                                Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, s.LeftX + s.SizeWidth / 10, s.TopY + s.SizeHeight / 10, cdrDimensionStyleEngineering)
-                        
-                        Case "dn":
-                                Set pts = s.SnapPoints.BBox(cdrBottomLeft)
-                                Set pte = s.SnapPoints.BBox(cdrBottomRight)
-                                Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, s.LeftX + s.SizeWidth / 10, s.BottomY - s.SizeHeight / 10, cdrDimensionStyleEngineering)
-                        Case "lf":
-                                Set pts = s.SnapPoints.BBox(cdrTopLeft)
-                                Set pte = s.SnapPoints.BBox(cdrBottomLeft)
-                                Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, s.LeftX - s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering)
-                        Case "ri":
-                                Set pts = s.SnapPoints.BBox(cdrTopRight)
-                                Set pte = s.SnapPoints.BBox(cdrBottomRight)
-                                Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, s.RightX + s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering)
-                    End Select
-                    Dimension_SetProperty sh, PresetProperty.value
-                Next s
+  Set os = ActiveSelectionRange
+  
+  Dim border As Variant
+  Dim Line_len As Double
+  If shft > 1 Then
+    Line_len = API.Set_Space_Width  '// 设置文字空间间隙
+  Else
+    Line_len = API.Set_Space_Width(True)  '// 只读文字空间间隙
+  End If
+  
+  border = Array(cdrBottomRight, cdrBottomLeft, os.TopY + Line_len, os.TopY + 2 * Line_len, _
+  cdrBottomRight, cdrTopRight, os.LeftX - Line_len, os.LeftX - 2 * Line_len)
+  
+  If mirror = True Then border = Array(cdrTopRight, cdrTopLeft, os.BottomY - Line_len, os.BottomY - 2 * Line_len, _
+  cdrBottomLeft, cdrTopLeft, os.RightX + Line_len, os.RightX + 2 * Line_len)
+  
+#If VBA7 Then
+  If dr = "upbx" Or dr = "upb" Or dr = "dnb" Or dr = "up" Or dr = "dn" Then os.Sort "@shape1.left < @shape2.left"
+  If dr = "lfbx" Or dr = "lfb" Or dr = "rib" Or dr = "lf" Or dr = "ri" Then os.Sort "@shape1.top > @shape2.top"
+#Else
+  If dr = "upbx" Or dr = "upb" Or dr = "dnb" Or dr = "up" Or dr = "dn" Then Set os = X4_Sort_ShapeRange(os, stlx)
+  If dr = "lfbx" Or dr = "lfb" Or dr = "rib" Or dr = "lf" Or dr = "ri" Then Set os = X4_Sort_ShapeRange(os, stty).ReverseRange
+#End If
+
+  
+  If os.Count > 0 Then
+    If os.Count > 1 And Len(dr) > 2 And os.Shapes.Count > 1 Then
+      For i = 1 To os.Shapes.Count - 1
+        Select Case dr
+          Case "upbx"
+#If VBA7 Then
+            Set pts = os.Shapes(i).SnapPoints.BBox(border(0))
+            Set pte = os.Shapes(i + 1).SnapPoints.BBox(border(1))
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, 0, border(2), cdrDimensionStyleEngineering)
+            
+            If shft > 0 And i = 1 Then
+              Dimension_SetProperty sh, PresetProperty.value
+              Set pts = os.FirstShape.SnapPoints.BBox(border(0))
+              Set pte = os.LastShape.SnapPoints.BBox(border(1))
+              Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, 0, border(3), cdrDimensionStyleEngineering)
+            End If
+          
+          Case "lfbx"
+            Set pts = os.Shapes(i).SnapPoints.BBox(border(4))
+            Set pte = os.Shapes(i + 1).SnapPoints.BBox(border(5))
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, border(6), 0, cdrDimensionStyleEngineering)
+            
+            If shft > 0 And i = 1 Then
+              Dimension_SetProperty sh, PresetProperty.value
+              Set pts = os.FirstShape.SnapPoints.BBox(border(4))
+              Set pte = os.LastShape.SnapPoints.BBox(border(5))
+              Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, border(7), 0, cdrDimensionStyleEngineering)
             End If
-        End If
+#Else
+' X4  There is a difference
+            Set pts = CreateSnapPoint(os.Shapes(i).CenterX, os.Shapes(i).CenterY)
+            Set pte = CreateSnapPoint(os.Shapes(i + 1).CenterX, os.Shapes(i + 1).CenterY)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, 0, border(2), Textsize:=18)
+            
+          Case "lfbx"
+            Set pts = CreateSnapPoint(os.Shapes(i).CenterX, os.Shapes(i).CenterY)
+            Set pte = CreateSnapPoint(os.Shapes(i + 1).CenterX, os.Shapes(i + 1).CenterY)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, border(6), 0, Textsize:=18)
+#End If
+          
+          Case "upb"
+            Set pts = os.Shapes(i).SnapPoints.BBox(cdrTopRight)
+            Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrTopLeft)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.TopY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
+            
+          Case "dnb"
+            Set pts = os.Shapes(i).SnapPoints.BBox(cdrBottomRight)
+            Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrBottomLeft)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.BottomY - os.SizeHeight / 10, cdrDimensionStyleEngineering)
+            
+          Case "lfb"
+            Set pts = os.Shapes(i).SnapPoints.BBox(cdrBottomLeft)
+            Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrTopLeft)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.LeftX - os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
+            
+          Case "rib"
+            Set pts = os.Shapes(i).SnapPoints.BBox(cdrBottomRight)
+            Set pte = os.Shapes(i + 1).SnapPoints.BBox(cdrTopRight)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.RightX + os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
+        End Select
+        '// 尺寸标注设置属性
+        Dimension_SetProperty sh, PresetProperty.value
+        'ActiveDocument.ClearSelection
+      Next i
+    Else
+      If shft > 0 Then
+        Select Case dr
+          Case "up"
+            Set pts = os.FirstShape.SnapPoints.BBox(cdrTopLeft)
+            Set pte = os.LastShape.SnapPoints.BBox(cdrTopRight)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.TopY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
+
+          Case "dn"
+            Set pts = os.FirstShape.SnapPoints.BBox(cdrBottomLeft)
+            Set pte = os.LastShape.SnapPoints.BBox(cdrBottomRight)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, os.LeftX + os.SizeWidth / 10, os.BottomY - os.SizeHeight / 10, cdrDimensionStyleEngineering)
+
+          Case "lf"
+            Set pts = os.FirstShape.SnapPoints.BBox(cdrTopLeft)
+            Set pte = os.LastShape.SnapPoints.BBox(cdrBottomLeft)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.LeftX - os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
+          
+          Case "ri"
+            Set pts = os.FirstShape.SnapPoints.BBox(cdrTopRight)
+            Set pte = os.LastShape.SnapPoints.BBox(cdrBottomRight)
+            Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, os.RightX + os.SizeWidth / 10, os.BottomY + os.SizeHeight / 10, cdrDimensionStyleEngineering)
+        End Select
+        Dimension_SetProperty sh, PresetProperty.value
+      Else
+        For Each s In os.Shapes
+          Select Case dr
+            Case "up"
+              Set pts = s.SnapPoints.BBox(cdrTopLeft)
+              Set pte = s.SnapPoints.BBox(cdrTopRight)
+              Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, s.LeftX + s.SizeWidth / 10, s.TopY + s.SizeHeight / 10, cdrDimensionStyleEngineering)
+            
+            Case "dn"
+              Set pts = s.SnapPoints.BBox(cdrBottomLeft)
+              Set pte = s.SnapPoints.BBox(cdrBottomRight)
+              Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, s.LeftX + s.SizeWidth / 10, s.BottomY - s.SizeHeight / 10, cdrDimensionStyleEngineering)
+            
+            Case "lf"
+              Set pts = s.SnapPoints.BBox(cdrTopLeft)
+              Set pte = s.SnapPoints.BBox(cdrBottomLeft)
+              Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, s.LeftX - s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering)
+            
+            Case "ri"
+              Set pts = s.SnapPoints.BBox(cdrTopRight)
+              Set pte = s.SnapPoints.BBox(cdrBottomRight)
+              Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, pte, True, s.RightX + s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering)
+          End Select
+          Dimension_SetProperty sh, PresetProperty.value
+        Next s
+      End If
     End If
-    os.CreateSelection
-    
+  End If
+  os.CreateSelection
+  
 ErrorHandler:
+  
   API.EndOpt
 End Sub
 
 Sub make_sizes(Optional shft = 0)
-  On Error GoTo ErrorHandler
-  API.BeginOpt
+'  On Error GoTo ErrorHandler
+'  API.BeginOpt
   
   Dim s As Shape
   Dim pts As SnapPoint, pte As SnapPoint
@@ -324,13 +342,24 @@ Sub make_sizes(Optional shft = 0)
   Set os = ActiveSelectionRange
   If os.Count > 0 Then
   For Each s In os.Shapes
+#If VBA7 Then
       Set pts = s.SnapPoints.BBox(cdrTopLeft)
       Set pte = s.SnapPoints.BBox(cdrTopRight)
       Set ptle = s.SnapPoints.BBox(cdrBottomLeft)
       If shft <> 6 Then Dimension_SetProperty ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pts, ptle, True, _
                                               s.LeftX - s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering), PresetProperty.value
       If shft <> 3 Then Dimension_SetProperty ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pts, pte, True, _
-                                              s.LeftX + s.SizeWidth / 10, s.TopY + s.SizeHeight / 10, cdrDimensionStyleEngineering), PresetProperty.value
+                                          s.LeftX + s.SizeWidth / 10, s.TopY + s.SizeHeight / 10, cdrDimensionStyleEngineering), PresetProperty.value
+#Else
+' X4  There is a difference
+      Set pts = s.SnapPoints(cdrTopLeft)
+      Set pte = s.SnapPoints(cdrTopRight)
+      Set ptle = s.SnapPoints(cdrBottomLeft)
+      If shft <> 6 Then ActiveLayer.CreateLinearDimension cdrDimensionVertical, pts, ptle, True, _
+                      s.LeftX - s.SizeWidth / 10, s.BottomY + s.SizeHeight / 10, cdrDimensionStyleEngineering, Textsize:=18
+      If shft <> 3 Then ActiveLayer.CreateLinearDimension cdrDimensionHorizontal, pts, pte, True, _
+                      s.LeftX + s.SizeWidth / 10, s.TopY + s.SizeHeight / 10, cdrDimensionStyleEngineering, Textsize:=18
+#End If
   Next s
   End If
 
@@ -338,31 +367,30 @@ ErrorHandler:
   API.EndOpt
 End Sub
 
+'// 节点连接合并
 Private Sub btn_join_nodes_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     ActiveSelection.CustomCommand "ConvertTo", "JoinCurves"
     Application.Refresh
 End Sub
 
+'// 节点优化减少
 Private Sub btn_nodes_reduce_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
-    On Error GoTo ErrorHandler
-    Set doc = ActiveDocument
-    Dim s As Shape
-    ps = Array(1)
-    doc.Unit = cdrTenthMicron
-    Set os = ActivePage.Shapes
-    If os.Count > 0 Then
-        doc.BeginCommandGroup "reduce nodes"
-        For Each s In os
-            s.ConvertToCurves
-            If Not s.DisplayCurve Is Nothing Then
-                s.Curve.AutoReduceNodes 50
-            End If
-        Next s
-        doc.EndCommandGroup
-    End If
-    Application.Refresh
+  On Error GoTo ErrorHandler: API.BeginOpt
+  Set doc = ActiveDocument
+  Dim s As Shape
+  ps = Array(1)
+  doc.Unit = cdrTenthMicron
+  Set os = ActivePage.Shapes
+  If os.Count > 0 Then
+    For Each s In os
+    s.ConvertToCurves
+      If Not s.DisplayCurve Is Nothing Then
+        s.Curve.AutoReduceNodes 50
+      End If
+    Next s
+  End If
 ErrorHandler:
-  MsgBox "s.Curve.AutoReduceNodes 只有高版本才支持本API"
+  API.EndOpt
 End Sub
 
 '// 使用标记线批量建立尺寸标注:   左键上标注，右键右标注
@@ -476,8 +504,11 @@ Private Function Slanted_Sort_Make(shs As ShapeRange)
   
   CutLines.RemoveDuplicates sr  '// 简单删除重复算法
   
+#If VBA7 Then
   sr.Sort "@shape1.left < @shape2.left"
-
+#Else
+  Set sr = X4_Sort_ShapeRange(sr, stlx)
+#End If
   For i = 1 To sr.Count - 1
     x1 = sr(i + 1).CenterX
     y1 = sr(i + 1).CenterY
@@ -486,8 +517,12 @@ Private Function Slanted_Sort_Make(shs As ShapeRange)
     
     Set pts = CreateSnapPoint(x1, y1)
     Set pte = CreateSnapPoint(x2, y2)
+#If VBA7 Then
     Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionSlanted, pts, pte, True, x1 - 20, y1 + 20, cdrDimensionStyleEngineering)
-    
+#Else
+' X4  There is a difference
+    Set sh = ActiveLayer.CreateLinearDimension(cdrDimensionSlanted, pts, pte, True, (x1 + x2) / 2, (y1 + y2) / 2, cdrDimensionStyleEngineering, Textsize:=18)
+#End If
     Dimension_SetProperty sh, PresetProperty.value
   Next i
   sr.Delete
@@ -498,6 +533,7 @@ End Function
 
 '// 尺寸标注设置属性
 Private Function Dimension_SetProperty(sh_dim As Shape, Optional ByVal Preset As Boolean = False)
+#If VBA7 Then
   If Preset And sh_dim.Type = cdrLinearDimensionShape Then
     With sh_dim.Style.GetProperty("dimension")
       .SetProperty "precision", 0 '       小数位数
@@ -507,6 +543,10 @@ Private Function Dimension_SetProperty(sh_dim As Shape, Optional ByVal Preset As
     '  .SetProperty "overhang", 500000 '
     End With
   End If
+  
+#Else
+' X4  There is a difference
+#End If
 End Function
 
 

UI/frmSelectSame.bas

@@ -1,10 +1,10 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmSelectSame 
-   Caption         =   "相似选择-魔改版 蘭雅"
-   ClientHeight    =   5775
+   Caption         =   "Similar Selection Plus"
+   ClientHeight    =   5745
    ClientLeft      =   495
    ClientTop       =   5895
-   ClientWidth     =   2625
+   ClientWidth     =   3255
    OleObjectBlob   =   "frmSelectSame.frx":0000
    ShowModal       =   0   'False
 End
@@ -28,6 +28,12 @@ Public ssreg As ShapeRange
 Private Const TOOLNAME As String = "VBA_SelectSame"
 Private Const SECTION As String = "Options"
 
+Private Sub UserForm_Initialize()
+  LNG_CODE = Val(GetSetting("LYVBA", "Settings", "I18N_LNG", "1033"))
+  Init_Translations Me, LNG_CODE
+  Me.Caption = i18n("Similar Selection Plus", LNG_CODE)
+End Sub
+
 Private Sub btnSelect_Click()
     If 0 = ActiveSelectionRange.Count Then Exit Sub
     On Error GoTo ErrorHandler
@@ -265,7 +271,7 @@ Private Function ShapesMatch_Font_Name(ByVal fsn As Shape, sr As ShapeRange, Che
     End If
     
   Case "ShapeName"
-    sh_name = fsn.Name
+    sh_name = fsn.name
       Set sr = sr.Shapes.FindShapes(Query:="@name ='" & sh_name & "'")
   End Select
 End Function
@@ -435,7 +441,7 @@ Private Function ShapesMatch(shpShape As Shape, shpModel As Shape, _
                         Set clrModel = fillModel.UniformColor
                         lngType = .UniformColor.Type
                         If lngType <> clrModel.Type Then GoTo NoMatch
-                        If .UniformColor.Name(True) <> clrModel.Name(True) Then GoTo NoMatch
+                        If .UniformColor.name(True) <> clrModel.name(True) Then GoTo NoMatch
                     End If  'GDG #############################################################
                 End If
             End With
@@ -453,7 +459,7 @@ Private Function ShapesMatch(shpShape As Shape, shpModel As Shape, _
                                                 
                         If lngType > 0 Then     'Does the shape have an OUTLINE ?
                                                 'Same LINE WIDTH ?
-                            If .Width <> outlnModel.Width Then GoTo NoMatch
+                            If .width <> outlnModel.width Then GoTo NoMatch
                                                 'Matching LINE COLOR ?
 '                            Set clrShape = .Color
 '                            lngType = clrShape.Type
@@ -494,7 +500,7 @@ Private Function ShapesMatch(shpShape As Shape, shpModel As Shape, _
                                 lngType = clrShape.Type
                                 Set clrModel = outlnModel.Color
                                 If lngType <> clrModel.Type Then GoTo NoMatch
-                                If clrShape.Name(True) <> clrModel.Name(True) _
+                                If clrShape.name(True) <> clrModel.name(True) _
                                     Then GoTo NoMatch
                             End If
                         End If

donate.md

@@ -47,6 +47,7 @@ a-嘉盟
 肥崽很忙
 Thanh Van
 友佳友汇
+创忆电脑
 ```
 
 

module/ALGO.bas

@@ -0,0 +1,125 @@
+Attribute VB_Name = "ALGO"
+'// Algorithm 模块
+#If VBA7 Then
+'// For CorelDRAW X6-2023  62bit
+Public Declare PtrSafe Function i18n Lib "C:\TSP\lyvba.dll" (ByVal str As String, ByVal code As Long) As String
+Private Declare PtrSafe Function sort_byitem Lib "C:\TSP\lyvba.dll" (ByRef sr_Array As ShapeProperties, ByVal size As Long, _
+                      ByVal Sort_By As SortItem, ByRef ret_Array As Long) As Long
+#Else
+'// For CorelDRAW X4  32bit
+Declare Function sort_byitem Lib "C:\TSP\lyvba32.dll" (ByRef sr_Array As ShapeProperties, ByVal size As Long, _
+                      ByVal Sort_By As SortItem, ByRef ret_Array As Long) As Long
+#End If
+
+Type ShapeProperties
+  Item As Long                 '// ShapeRange.Item
+  StaticID As Long             '// Shape.StaticID
+  lx As Double: rx As Double   '// s.LeftX  s.RightX  s.BottomY  s.TopY
+  by As Double: ty As Double
+  cx As Double: cy As Double   '// s.CenterX  s.CenterY s.SizeWidth s.SizeHeight
+  sw As Double: sh As Double
+End Type
+
+Enum SortItem
+  stlx
+  strx
+  stby
+  stty
+  stcx
+  stcy
+  stsw
+  stsh
+  Area
+  topWt_left
+End Enum
+
+Public LNG_CODE As Long
+
+Private Sub Test_Sort_ShapeRange()
+  API.BeginOpt
+  Dim sr As ShapeRange, ssr As ShapeRange
+  Dim s As Shape
+  Set sr = ActiveSelectionRange
+  Set ssr = ShapeRange_To_Sort_Array(sr, topWt_left)
+
+  '// s 调整次序
+  For Each s In ssr
+    s.OrderToFront
+  Next s
+
+  MsgBox "ShapeRange_SortItem:" & " " & topWt_left & "  枚举值"
+  API.EndOpt
+End Sub
+
+Public Function X4_Sort_ShapeRange(ByRef sr As ShapeRange, ByRef Sort_By As SortItem) As ShapeRange
+  Set X4_Sort_ShapeRange = ShapeRange_To_Sort_Array(sr, Sort_By)
+End Function
+
+'// 映射 ShapeRange 到 Array 然后调用 DLL库排序
+Private Function ShapeRange_To_Sort_Array(ByRef sr As ShapeRange, ByRef Sort_By As SortItem) As ShapeRange
+  On Error GoTo ErrorHandler
+  Dim sp As ShapeProperties
+  Dim size As Long, ret As Long
+  Dim s As Shape
+  size = sr.Count
+  
+  Dim sr_Array() As ShapeProperties
+  Dim ret_Array() As Long
+  ReDim ret_Array(1 To size)
+  ReDim sr_Array(1 To size)
+  
+  For Each s In sr
+    sp.Item = sr.IndexOf(s)
+    sp.StaticID = s.StaticID
+    sp.lx = s.LeftX: sp.rx = s.RightX
+    sp.by = s.BottomY: sp.ty = s.TopY
+    sp.cx = s.CenterX: sp.cy = s.CenterY
+    sp.sw = s.SizeWidth: sp.sh = s.SizeHeight
+    sr_Array(sp.Item) = sp
+  Next s
+
+  '// 在VBA中数组的索引从1开始, 将数组的地址传递给函数需要Arr(1)方式
+  '// C/C++ 函数定义 int __stdcall SortByItem(ShapeProperties* sr_Array, int size, SortItem Sort_By, int* ret_Array)
+  '// sr_Array首地址，size 长度， Sort_By 排序方式, 返回数组 ret_Array
+  ret = sort_byitem(sr_Array(1), size, Sort_By, ret_Array(1))
+  
+  If ret = size Then
+    Dim srcp As New ShapeRange, i As Integer
+    For i = 1 To size
+      srcp.Add sr(ret_Array(i))
+    Next i
+    
+    Set ShapeRange_To_Sort_Array = srcp
+  End If
+  
+ErrorHandler:
+
+End Function
+
+
+Private Sub Test_i18n()
+  MsgBox i18n("Nodes", 2052)
+  MsgBox i18n("Nodes", 1033)
+  MsgBox i18n("Preset Property", 2052)
+End Sub
+
+
+Public Function Init_Translations(frm As UserForm, code As Long)
+    Dim ctl As Variant: Dim en As String
+    LNG_CODE = code
+    
+    For Each ctl In frm.Controls
+    If TypeOf ctl Is MSForms.Label Or TypeOf ctl Is MSForms.CommandButton Or TypeOf ctl Is MSForms.ToggleButton Or TypeOf ctl Is MSForms.CheckBox Then
+        If Not IsNull(ctl.Caption) And ctl.Caption <> "" Then
+          en = ctl.Caption
+          ctl.Caption = i18n(en, LNG_CODE)
+        End If
+        If Not IsNull(ctl.ControlTipText) And ctl.ControlTipText <> "" Then
+          en = ctl.ControlTipText
+          ctl.ControlTipText = i18n(en, LNG_CODE)
+        End If
+    End If
+  Next ctl
+  
+End Function
+

module/API.bas

@@ -3,15 +3,13 @@ Attribute VB_Name = "API"
 '// For more information, please refer to  https://github.com/hongwenjun
 
 '// Attribute VB_Name = "CorelVBA工具窗口启动"   CorelVBA Tool Window Launches  2023.6.11
-Public Sub Start()
-  Toolbar.Show 0
-End Sub
+
 
 '// CorelDRAW 窗口刷新优化和关闭
-Public Function BeginOpt(Optional ByVal Name As String = "Undo")
+Public Function BeginOpt(Optional ByVal name As String = "Undo")
   EventsEnabled = False
-  ActiveDocument.BeginCommandGroup Name
-  ActiveDocument.SaveSettings
+  ActiveDocument.BeginCommandGroup name
+' ActiveDocument.SaveSettings
   ActiveDocument.Unit = cdrMillimeter
   Optimization = True
 ' ActiveDocument.PreserveSelection = False
@@ -19,10 +17,11 @@ End Function
 
 Public Function EndOpt()
 ' ActiveDocument.PreserveSelection = True
-  ActiveDocument.RestoreSettings
+' ActiveDocument.RestoreSettings
   EventsEnabled = True
   Optimization = False
   EventsEnabled = True
+  ActiveDocument.ReferencePoint = cdrBottomLeft
   Application.Refresh
   ActiveDocument.EndCommandGroup
 End Function
@@ -113,13 +112,13 @@ Public Function WriteClipBoard(ByVal s As String)
 End Function
 
 '// 换行转空格 多个空格换成一个空格
-Public Function Newline_to_Space(ByVal Str As String) As String
-  Str = VBA.Replace(Str, Chr(13), " ")
-  Str = VBA.Replace(Str, Chr(9), " ")
-  Do While InStr(Str, "  ")
-      Str = VBA.Replace(Str, "  ", " ")
+Public Function Newline_to_Space(ByVal str As String) As String
+  str = VBA.Replace(str, Chr(13), " ")
+  str = VBA.Replace(str, Chr(9), " ")
+  Do While InStr(str, "  ")
+      str = VBA.Replace(str, "  ", " ")
   Loop
-  Newline_to_Space = Str
+  Newline_to_Space = str
 End Function
 
 '// 获得数组元素个数
@@ -202,14 +201,14 @@ Public Function pFootInXY(P, a, b)
     If a(1) = b(1) Then
         pFootInXY = Array(P(0), a(1), 0#): Exit Function
     End If
-    Dim aa, bb, c, d, X, Y
+    Dim aa, bb, c, d, x, Y
     aa = (a(1) - b(1)) / (a(0) - b(0))
     bb = a(1) - aa * a(0)
     c = -(a(0) - b(0)) / (a(1) - b(1))
     d = P(1) - c * P(0)
-    X = (d - bb) / (aa - c)
-    Y = aa * X + bb
-    pFootInXY = Array(X, Y, 0#)
+    x = (d - bb) / (aa - c)
+    Y = aa * x + bb
+    pFootInXY = Array(x, Y, 0#)
 End Function
 
 
@@ -245,13 +244,6 @@ Public Function ExistsFile_UseFso(ByVal strPath As String) As Boolean
      Set fso = Nothing
 End Function
 
-Public Function WebHelp(url As String)
-  Dim h As Long, r As Long
-  h = FindWindow(vbNullString, "Toolbar")
-  r = ShellExecute(h, "", url, "", "", 1)
-End Function
-
-
 Public Function test_sapi()
   Dim message, sapi
   MsgBox ("Please use the headset and listen to what I have to say...")
@@ -260,3 +252,10 @@ Public Function test_sapi()
   sapi.Speak message
 End Function
 
+
+' Public Function WebHelp(url As String)
+'  Dim h As Longer, r As Long
+'  h = FindWindow(vbNullString, "Toolbar")
+'  r = ShellExecute(h, "", url, "", "", 1)
+' End Function
+