捐赠网友将送商业版注册激活码一份

UI/ArrangeForm.bas

@@ -1,21 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ArrangeForm 
-   Caption         =   "蘭雅sRGB 自动拼版 │ 嘉盟赞助"
-   ClientHeight    =   2475
-   ClientLeft      =   45
-   ClientTop       =   330
-   ClientWidth     =   4650
-   OleObjectBlob   =   "ArrangeForm.frx":0000
-   ShowModal       =   0   'False
-   StartUpPosition =   2  '屏幕中心
-   WhatsThisButton =   -1  'True
-   WhatsThisHelp   =   -1  'True
-End
-Attribute VB_Name = "ArrangeForm"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
 '// 用户窗口初始化
 Private Sub UserForm_Initialize()
   ActiveDocument.Unit = cdrMillimeter

UI/CQL_FIND_UI.bas

@@ -1,17 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CQL_FIND_UI 
-   ClientHeight    =   7830
-   ClientLeft      =   45
-   ClientTop       =   330
-   ClientWidth     =   11610
-   OleObjectBlob   =   "CQL_FIND_UI.frx":0000
-   StartUpPosition =   1  '所有者中心
-End
-Attribute VB_Name = "CQL_FIND_UI"
-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
 

UI/MakeSizePlus.bas

@@ -1,19 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} MakeSizePlus 
-   Caption         =   "Batch Dimension Nodes"
-   ClientHeight    =   1680
-   ClientLeft      =   45
-   ClientTop       =   330
-   ClientWidth     =   3900
-   OleObjectBlob   =   "MakeSizePlus.frx":0000
-   StartUpPosition =   1  '所有者中心
-End
-Attribute VB_Name = "MakeSizePlus"
-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
 
@@ -36,6 +20,63 @@ Private Const GWL_EXSTYLE = (-20)
 Private Const WS_CAPTION As Long = &HC00000
 Private Const WS_EX_DLGMODALFRAME = &H1&
 
+'// 插件名称 VBA_UserForm
+Private Const TOOLNAME As String = "LYVBA"
+Private Const SECTION As String = "MakeSizePlus"
+Private sreg As New ShapeRange
+
+Private Sub Frame1_Click()
+
+End Sub
+
+Private Sub UserForm_Initialize()
+  With Me
+    .StartUpPosition = 0
+    .Left = Val(GetSetting(TOOLNAME, SECTION, "form_left", 900))
+    .Top = Val(GetSetting(TOOLNAME, SECTION, "form_top", 200))
+    .width = Val(GetSetting(TOOLNAME, SECTION, "form_width", 200))
+    .Height = Val(GetSetting(TOOLNAME, SECTION, "form_Height", 105))
+  End With
+
+  LNG_CODE = Val(GetSetting("LYVBA", "Settings", "I18N_LNG", "1033"))
+  Init_Translations Me, LNG_CODE
+  Me.Caption = i18n("Batch Dimension Plus", LNG_CODE)
+  
+   ' 读取线设置
+  Bleed.text = API.GetSet("Bleed")
+  Line_len.text = API.GetSet("Line_len")
+  Outline_Width.text = GetSetting("LYVBA", "Settings", "Outline_Width", "0.2")
+  
+End Sub
+
+'// 关闭窗口时保存窗口位置
+Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
+    saveFormPos True
+End Sub
+
+'// 保存窗口位置和加载窗口位置
+Sub saveFormPos(bDoSave As Boolean)
+  If bDoSave Then 'save position
+    SaveSetting TOOLNAME, SECTION, "form_left", Me.Left
+    SaveSetting TOOLNAME, SECTION, "form_top", Me.Top
+    SaveSetting TOOLNAME, SECTION, "form_width", Me.width
+    SaveSetting TOOLNAME, SECTION, "form_Height", Me.Height
+  End If
+End Sub
+
+Private Sub btn_ExpandForm_Click()
+  With Me
+    If .width = 200 Then
+      .width = 260: .Height = 132
+    ElseIf .Height = 132 Then
+      .Height = 206
+    Else
+      .width = 200: .Height = 105
+    End If
+  End With
+End Sub
+
+
 '// Minimizes the window and retains dimensioning functionality   '// 最小化窗口并保留标注尺寸功能
 Private Function MiniForm()
 
@@ -83,34 +124,17 @@ 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)
-  API.BeginOpt
-  Set os = ActiveSelectionRange
-  Set ss = os.Shapes
-  For Each s In ss
-    s.SizeWidth = s.SizeHeight
-  Next s
-  API.EndOpt
+Private Sub Settings_Click()
+  If 0 < Val(Bleed.text) * Val(Line_len.text) < 100 Then
+   SaveSetting "LYVBA", "Settings", "Bleed", Bleed.text
+   SaveSetting "LYVBA", "Settings", "Line_len", Line_len.text
+   SaveSetting "LYVBA", "Settings", "Outline_Width", Outline_Width.text
+   Call API.Set_Space_Width  '// 设置空间间隙
+  End If
 End Sub
 
 
-Private Sub btn_square_wi_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
-  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)
+Private Sub btn_Makesizes_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   On Error GoTo ErrorHandler
   API.BeginOpt
   Dim os As ShapeRange
@@ -164,27 +188,17 @@ Sub make_sizes_sep(dr, Optional shft = 0, Optional ByVal mirror As Boolean = Fal
   
   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
-  
+  Line_len = API.Set_Space_Width(True)  '// 读取间隔
+
   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
@@ -343,34 +357,8 @@ 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: 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:
-  API.EndOpt
-End Sub
-
 '// 使用标记线批量建立尺寸标注:   左键上标注，右键右标注
-Private Sub MarkLines_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub MarkLines_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   Dim sr As ShapeRange
   Set sr = ActiveSelectionRange
   
@@ -399,34 +387,16 @@ Private Sub MarkLines_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As I
 End Sub
 
 '// 使用手工选节点建立尺寸标注，使用Ctrl分离尺寸标注
-Private Sub Manual_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Manual_Makesize_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
       '// 右键
   ElseIf Shift = fmCtrlMask Then
       Slanted_Makesize  '// 手动标注倾斜尺寸
   Else
-      Untie_MarkLines   '// 解绑尺寸，分离尺寸
+      ModulePlus.Untie_MarkLines   '// 解绑尺寸，分离尺寸
   End If
 End Sub
 
-
-
-'// 解绑尺寸，分离尺寸
-Private Function Untie_MarkLines()
-  Dim os As ShapeRange, dss As New ShapeRange
-  Set os = ActiveSelectionRange
-  For Each s In os.Shapes
-      If s.Type = cdrLinearDimensionShape Then
-        dss.Add s
-      End If
-  Next s
-  If dss.Count > 0 Then
-    dss.BreakApartEx
-    os.Shapes.FindShapes(Query:="@name ='DMKLine'").CreateSelection
-    ActiveSelectionRange.Delete
-  End If
-End Function
-
 '// 手动标注倾斜尺寸
 Private Function Slanted_Makesize()
   On Error GoTo ErrorHandler
@@ -479,12 +449,8 @@ Private Function Slanted_Sort_Make(shs As ShapeRange)
   Next sh
   
   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
@@ -520,13 +486,14 @@ Private Function Dimension_SetProperty(sh_dim As Shape, Optional ByVal Preset As
     End With
   End If
   
+  sh_dim.Outline.width = API.GetSet("Outline_Width")
 #Else
 ' X4  There is a difference
 #End If
 End Function
 
 '// 尺寸标注左边
-Private Sub Makesize_Left_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Makesize_Left_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     CutLines.Dimension_MarkLines cdrAlignLeft, False
     make_sizes_sep "lfbx", Button, False
@@ -541,7 +508,7 @@ Private Sub Makesize_Left_MouseUp(ByVal Button As Integer, ByVal Shift As Intege
 End Sub
 
 '// 尺寸标注右边
-Private Sub Makesize_Right_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Makesize_Right_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     CutLines.Dimension_MarkLines cdrAlignLeft, True
     make_sizes_sep "lfbx", Button, True
@@ -557,7 +524,7 @@ Private Sub Makesize_Right_MouseUp(ByVal Button As Integer, ByVal Shift As Integ
 End Sub
 
 '// 尺寸标注向上
-Private Sub Makesize_Up_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Makesize_Up_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     CutLines.Dimension_MarkLines cdrAlignTop, False
     make_sizes_sep "upbx", Button, False
@@ -572,7 +539,7 @@ Private Sub Makesize_Up_MouseUp(ByVal Button As Integer, ByVal Shift As Integer,
 End Sub
 
 '// 尺寸标注向下
-Private Sub Makesize_Down_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Makesize_Down_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     CutLines.Dimension_MarkLines cdrAlignTop, True
     make_sizes_sep "upbx", Button, True
@@ -586,59 +553,167 @@ Private Sub Makesize_Down_MouseUp(ByVal Button As Integer, ByVal Shift As Intege
   End If
 End Sub
 
-Private Sub MakeRuler_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
-  If Button = 2 Then
+Private Sub MakeRuler_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+  On Error GoTo ErrorHandler
+  API.BeginOpt
+  Set sreg = Nothing
+  
+  If Button = 2 And Shift = 0 Then       '// 鼠标右键 标注右边
+    Ruler_Align cdrAlignRight
+    
+  ElseIf Button = 2 And Shift = 2 Then  '// Ctrl+鼠标右键 标注左边
+    Ruler_Align cdrAlignLeft
+ 
+  ElseIf Shift = 0 Then    '// 鼠标左键，标注在上边
+    Ruler_Align cdrAlignTop
+    
+  ElseIf Shift = 2 Then  '// Ctrl+鼠标左键，标注下边
+    Ruler_Align cdrAlignBottom
+  End If
+  
+  sreg.CreateSelection
+ErrorHandler:
+  API.EndOpt
+End Sub
+
+Private Sub MakeRuler_Align_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+  On Error GoTo ErrorHandler
+  API.BeginOpt
+  Set sreg = Nothing
+   
+  Dim ra As cdrAlignType
+  ra = cdrAlignTop
+  ' 定义方向上下左右
+  Dim pos_x As Variant, pos_y As Variant
+  pos_x = Array(27, 27, 12, 44)
+  pos_y = Array(12, 44, 27, 27)
+  If Abs(X - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    ra = cdrAlignTop
+  ElseIf Abs(X - pos_x(1)) < 14 And Abs(Y - pos_y(1)) < 14 Then
+    ra = cdrAlignBottom
+  ElseIf Abs(X - pos_x(2)) < 14 And Abs(Y - pos_y(2)) < 14 Then
+    ra = cdrAlignLeft
+  ElseIf Abs(X - pos_x(3)) < 14 And Abs(Y - pos_y(3)) < 14 Then
+    ra = cdrAlignRight
+  End If
+  
+  Ruler_Align ra
+  sreg.CreateSelection
+ErrorHandler:
+  API.EndOpt
+End Sub
+
+Private Function Ruler_Align(ra As cdrAlignType)
+  If ra = cdrAlignRight Then       '// 标注右边
+    CutLines.Dimension_MarkLines cdrAlignLeft, True
+    Add_Ruler_Text_Y True
+  ElseIf ra = cdrAlignLeft Then  '// 标注左边
     CutLines.Dimension_MarkLines cdrAlignLeft, False
     Add_Ruler_Text_Y True
-  Else
-    '// 建立标尺线
+  ElseIf ra = cdrAlignTop Then    '// 标注上边
     CutLines.Dimension_MarkLines cdrAlignTop, False
-    '// 标尺线转换成距离数字
+    Add_Ruler_Text True
+  ElseIf ra = cdrAlignBottom Then  '// 标注下边
+    CutLines.Dimension_MarkLines cdrAlignTop, True
     Add_Ruler_Text True
   End If
-End Sub
+End Function
 
   '// 标尺线转换成距离数字
 Private Function Add_Ruler_Text(rm_lines As Boolean)
+  On Error GoTo ErrorHandler
   API.BeginOpt
+  
   Dim s As Shape, t As Shape, sr As ShapeRange
   Dim text As String
   Set sr = ActiveSelectionRange
-  sr.Sort "@shape1.left < @shape2.left"
+  Set sr = X4_Sort_ShapeRange(sr, stlx)
   For Each s In sr
-    x = s.CenterX: Y = s.CenterY
-    text = str(Int(x - sr.FirstShape.CenterX + 0.5))
-    Set t = ActiveLayer.CreateArtisticText(x, Y, text)
-    t.CenterX = x: t.CenterY = Y
+    X = s.CenterX: Y = s.CenterY
+    text = str(Int(X - sr.FirstShape.CenterX + 0.5))
+    Set t = ActiveLayer.CreateArtisticText(X, Y, text)
+    t.CenterX = X: t.CenterY = Y
+    sreg.Add t
   Next
   
   If rm_lines Then sr.Delete
-  
+ErrorHandler:
   API.EndOpt
 End Function
 
   '// 标尺线转换成距离数字
 Private Function Add_Ruler_Text_Y(rm_lines As Boolean)
+  On Error GoTo ErrorHandler
   API.BeginOpt
+  
   Dim s As Shape, t As Shape, sr As ShapeRange
   Dim text As String
   Set sr = ActiveSelectionRange
-  sr.Sort "@shape1.top < @shape2.top"
+  Set sr = X4_Sort_ShapeRange(sr, stty)
   For Each s In sr
-    x = s.CenterX: Y = s.CenterY
+    X = s.CenterX: Y = s.CenterY
     text = str(Int(Y - sr.FirstShape.CenterY + 0.5))
-    Set t = ActiveLayer.CreateArtisticText(x, Y, text)
-    t.CenterX = x: t.CenterY = Y
+    Set t = ActiveLayer.CreateArtisticText(X, Y, text)
+    t.Rotate 90
+    t.CenterX = X: t.CenterY = Y
+    sreg.Add t
   Next
   
   If rm_lines Then sr.Delete
-  
+ErrorHandler:
   API.EndOpt
 End Function
 
-
 Private Sub X_EXIT_Click()
+  Me.width = 200: Me.Height = 105
   Unload Me    '// EXIT
 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 Bt_SplitSegment_Click()
+  ModulePlus.SplitSegment
+End Sub
+
+Private Sub btn_square_hi_Click()
+  ModulePlus.square_hw "Height"
+End Sub
+
+Private Sub btn_square_wi_Click()
+  ModulePlus.square_hw "Width"
+End Sub
+
+'// 节点连接合并
+Private Sub btn_join_nodes_Click()
+    ActiveSelection.CustomCommand "ConvertTo", "JoinCurves"
+    Application.Refresh
+End Sub
+
+'// 节点优化减少
+Private Sub btn_nodes_reduce_Click()
+  ModulePlus.Nodes_Reduce
+End Sub
+
+'// 选择标注线 选择文字 删除或者解绑标准线
+Private Sub SelectText_Click()
+  ModulePlus.Dimension_Select_or_Delete 4
+End Sub
+Private Sub SelectLine_Click()
+  ModulePlus.Dimension_Select_or_Delete 1
+End Sub
+Private Sub Delete_Dimension_Click()
+  ModulePlus.Dimension_Select_or_Delete 2
+End Sub
+Private Sub bt_Untie_MarkLines_Click()
+  ModulePlus.Untie_MarkLines
+End Sub

UI/Make_SIZE.bas

@@ -1,13 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Make_SIZE 
-   Caption         =   " 标注尺寸"
-   ClientHeight    =   1515
-   ClientLeft      =   45
-   ClientTop       =   390
-   ClientWidth     =   3690
-   OleObjectBlob   =   "Make_SIZE.frx":0000
-   StartUpPosition =   1  '所有者中心
-End
 Attribute VB_Name = "Make_SIZE"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False

UI/PhotoForm.bas

@@ -1,20 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} PhotoForm 
-   Caption         =   "批量转图片和导出JPEG"
-   ClientHeight    =   1755
-   ClientLeft      =   45
-   ClientTop       =   375
-   ClientWidth     =   3855
-   OleObjectBlob   =   "PhotoForm.frx":0000
-   ShowModal       =   0   'False
-   StartUpPosition =   1  '所有者中心
-End
-Attribute VB_Name = "PhotoForm"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-
 Private Sub UserForm_Initialize()
     On Error Resume Next
     ComboBox1.AddItem "灰度"

UI/Replace_UI.bas

@@ -1,19 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Replace_UI 
-   Caption         =   "使剪贴板上的物件替换选择的目标物件"
-   ClientHeight    =   4560
-   ClientLeft      =   45
-   ClientTop       =   330
-   ClientWidth     =   7590
-   OleObjectBlob   =   "Replace_UI.frx":0000
-   StartUpPosition =   1  '所有者中心
-End
-Attribute VB_Name = "Replace_UI"
-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

UI/Toolbar.bas

@@ -1,21 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Toolbar 
-   Caption         =   "Toolbar"
-   ClientHeight    =   4230
-   ClientLeft      =   45
-   ClientTop       =   330
-   ClientWidth     =   6840
-   OleObjectBlob   =   "Toolbar.frx":0000
-End
-Attribute VB_Name = "Toolbar"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-<<<<<<< HEAD
-=======
-
->>>>>>> c35edb3649c86cf525848e6148444292197aa8ca
 '// This is free and unencumbered software released into the public domain.
 '// For more information, please refer to  https://github.com/hongwenjun
 
@@ -135,7 +117,7 @@ End With
   #End If
 End Sub
 
-Private Sub UI_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub UI_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   UI.Visible = False
   If Y > 1 And Y < 16 And UIL_Key Then
     UI.Picture = pic2
@@ -147,9 +129,9 @@ Private Sub UI_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal
   ' Debug.Print X & " , " & Y
 End Sub
 
-Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+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
@@ -158,15 +140,15 @@ Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer,
 
 End Sub
 
-Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button Then
-    Me.Left = Me.Left - mx + x
+    Me.Left = Me.Left - mx + X
     Me.Top = Me.Top - my + Y
   End If
 End Sub
 
-Private Sub LOGO_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
-  If Abs(x - 14) < 14 And Abs(Y - 14) < 14 And Button = 2 Then
+Private Sub LOGO_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+  If Abs(X - 14) < 14 And Abs(Y - 14) < 14 And Button = 2 Then
     Me.width = 336
     OPEN_UI_BIG.Left = 322
     UI.Visible = True
@@ -175,20 +157,20 @@ 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
 End Sub
 
-Private Sub LOGO_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub LOGO_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button Then
-    Me.Left = Me.Left - mx + x
+    Me.Left = Me.Left - mx + X
     Me.Top = Me.Top - my + Y
   End If
 End Sub
 
-Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+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, pos_y As Variant
@@ -197,37 +179,37 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
 
   '// 按下Ctrl键，最优先处理工具功能
   If Shift = 2 Then
-    If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    If Abs(X - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
       '// 安全线，清除辅助线
-      Tools.guideangle CorelDRAW.ActiveSelectionRange, 3    ' 左键 3mm 出血
+      Tools.guideangle ActiveSelectionRange, 3    ' 左键 3mm 出血
       
-    ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    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
+    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
+    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(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(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(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
       '// 木头人智能群组，异形群组
       autogroup("group", 1).CreateSelection
       
-    ElseIf Abs(x - pos_x(8)) < 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
       
-    ElseIf Abs(x - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    ElseIf Abs(X - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
       ' 文本转曲  参数 all=1 ，支持框选和图框剪裁内的文本
       ' Tools.TextShape_ConvertToCurves 1
     End If
@@ -237,16 +219,16 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
 
   '// 鼠标右键 扩展键按钮优先  收缩工具栏  标记范围框  居中页面 尺寸取整数  单色黑中线标记 扩展工具栏  排列工具  扩展工具栏收缩
   If Button = 2 Then
-    If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 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(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    ElseIf Abs(X - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
       '// 居中页面
       Tools.Align_Page_Center
 
-    ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    ElseIf Abs(X - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     
       If Github_Version = 1 Then
         '// 单线条转裁切线 - 放置到页面四边
@@ -256,49 +238,44 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
         Tools.Mark_Range_Box
       End If
 
-    ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    ElseIf Abs(X - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
       '// 批量设置物件尺寸整数
       Tools.Size_to_Integer
     
     '//分分合合把几个功能按键合并到一起，定义到右键上
-    ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    ElseIf Abs(X - pos_x(4)) < 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
+    ElseIf Abs(X - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
       '// 自动中线色阶条 黑白
       AutoColorMark.Auto_ColorMark_K
 
-    ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    ElseIf Abs(X - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
      '// 智能群组
       SmartGroup.Smart_Group API.Create_Tolerance
       
-    ElseIf Abs(x - pos_x(7)) < 14 And Abs(Y - pos_y(0)) < 14 Then
-<<<<<<< HEAD
+    ElseIf Abs(X - pos_x(7)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     If Github_Version = 1 Then
       CQL_FIND_UI.Show 0
     Else
       '// 选择相同工具增强版
       frmSelectSame.Show 0
     End If
-=======
-     '// 选择相同工具增强版
-      frmSelectSame.Show 0
->>>>>>> c35edb3649c86cf525848e6148444292197aa8ca
 
-    ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    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
+    ElseIf Abs(X - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
      '// 文本统计信息
      Application.FrameWork.Automation.InvokeItem "bf3bd8fe-ca26-4fe0-91b0-3b5c99786fb6"
 
-    ElseIf Abs(x - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+    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
+    ElseIf Abs(X - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 Then
       '// 右键扩展工具栏收缩
       Me.Height = 30
       
@@ -307,43 +284,38 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
   End If
   
   '// 鼠标左键 单击按钮功能  按工具栏上图标正常功能
-  If Abs(x - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  If Abs(X - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
    '// 裁切线: 批量物件裁切线
     CutLines.Batch_CutLines
     
-  ElseIf Abs(x - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(1)) < 14 And Abs(Y - pos_y(0)) < 14 Then
   '// 剪贴板尺寸建立矩形
     ClipbRectangle.Build_Rectangle
     
-  ElseIf Abs(x - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     If Github_Version = 1 Then
-<<<<<<< HEAD
       MakeSizePlus.Show 0
-=======
-      Woodman.Show 0
->>>>>>> c35edb3649c86cf525848e6148444292197aa8ca
     Else
       '// 单线条转裁切线 - 放置到页面四边
       CutLines.SelectLine_to_Cropline
     End If
-  ElseIf Abs(x - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     '// 拼版.Arrange
     Arrange.Arrange
     
-  ElseIf Abs(x - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(4)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     '// 拼版裁切线
     CutLines.Draw_Lines
     
-  ElseIf Abs(x - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(5)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     '// 自动中线色阶条 彩色
     AutoColorMark.Auto_ColorMark
     
-  ElseIf Abs(x - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(6)) < 14 And Abs(Y - pos_y(0)) < 14 Then
    '// 智能群组 没容差
     SmartGroup.Smart_Group
     
-  ElseIf Abs(x - pos_x(7)) < 14 And Abs(Y - pos_y(0)) < 14 Then
-<<<<<<< HEAD
+  ElseIf Abs(X - pos_x(7)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     If Github_Version = 1 Then
        '// 选择相同工具增强版
       frmSelectSame.Show 0
@@ -351,24 +323,20 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
       CQL_FIND_UI.Show 0
     End If
 
-=======
-    CQL_FIND_UI.Show 0
-    
->>>>>>> c35edb3649c86cf525848e6148444292197aa8ca
-  ElseIf Abs(x - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     Replace_UI.Show 0
     
-  ElseIf Abs(x - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     ' 简单文本转曲
     Tools.TextShape_ConvertToCurves 0
     
-  ElseIf Abs(x - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(10)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     '// 扩展工具栏
     Me.Height = 30 + 45
     
     Speak_Msg "左右键有不同功能"
     
-  ElseIf Abs(x - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 Then
+  ElseIf Abs(X - pos_x(11)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     If Me.Height > 30 Then
       Me.Height = 30
     Else
@@ -400,7 +368,7 @@ End Sub
 ' End Sub
 
 '''///  贪心商人和好玩工具等  ///'''
-Private Sub Cdr_Nodes_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+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
   ElseIf Shift = fmCtrlMask Then
@@ -410,23 +378,23 @@ Private Sub Cdr_Nodes_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integ
   End If
 End Sub
 
-Private Sub Cdr_Nodes_BT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Cdr_Nodes_BT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   TSP_L1.ForeColor = RGB(0, 150, 255)
 End Sub
 
-Private Sub START_TSP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub START_TSP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   TSP_L2.ForeColor = RGB(0, 150, 255)
 End Sub
 
-Private Sub PATH_TO_TSP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub PATH_TO_TSP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   TSP_L3.ForeColor = RGB(0, 150, 255)
 End Sub
 
-Private Sub TSP2DRAW_LINE_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub TSP2DRAW_LINE_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   TSP_L4.ForeColor = RGB(0, 150, 255)
 End Sub
 
-Private Sub TSP2DRAW_LINE_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub TSP2DRAW_LINE_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     TSP.TSP_TO_DRAW_LINE
   ElseIf Shift = fmCtrlMask Then
@@ -503,7 +471,7 @@ Private Sub Tools_Icon_Click()
   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)
+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 "左键拆分线段，Ctrl合并线段"
   ElseIf Shift = fmCtrlMask Then
@@ -517,7 +485,7 @@ Private Sub Split_Segment_MouseDown(ByVal Button As Integer, ByVal Shift As Inte
 End Sub
 
 '''////  CorelDRAW 与 Adobe_Illustrator 剪贴板转换  ////'''
-Private Sub Adobe_Illustrator_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Adobe_Illustrator_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   Dim value As Integer
   If Button = 2 Then
     value = GMSManager.RunMacro("AIClipboard", "CopyPaste.PasteAIFormat")
@@ -531,7 +499,7 @@ Private Sub Adobe_Illustrator_MouseDown(ByVal Button As Integer, ByVal Shift As
 End Sub
 
 '''////  标记画框 支持容差  ////'''
-Private Sub Mark_CreateRectangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Mark_CreateRectangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     Tools.Mark_CreateRectangle True
   ElseIf Shift = fmCtrlMask Then
@@ -543,7 +511,7 @@ Private Sub Mark_CreateRectangle_MouseDown(ByVal Button As Integer, ByVal Shift
 End Sub
 
 '''////  一键拆开多行组合的文字字符  ////'''
-Private Sub Batch_Combine_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Batch_Combine_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     Tools.Batch_Combine
   ElseIf Shift = fmCtrlMask Then
@@ -554,7 +522,7 @@ Private Sub Batch_Combine_MouseDown(ByVal Button As Integer, ByVal Shift As Inte
 End Sub
 
 '''////  简单一刀切  ////'''
-Private Sub Single_Line_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+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
     Tools.Single_Line_Vertical
   ElseIf Shift = fmCtrlMask Then
@@ -565,7 +533,7 @@ Private Sub Single_Line_MouseDown(ByVal Button As Integer, ByVal Shift As Intege
 End Sub
 
 '''////  傻瓜火车排列  ////'''
-Private Sub TOP_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub TOP_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     Tools.Simple_Train_Arrangement 3#
   ElseIf Shift = fmCtrlMask Then
@@ -576,7 +544,7 @@ Private Sub TOP_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integ
 End Sub
 
 '''////  傻瓜阶梯排列  ////'''
-Private Sub LEFT_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub LEFT_ALIGN_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     Tools.Simple_Ladder_Arrangement 3#
   ElseIf Shift = fmCtrlMask Then
@@ -588,7 +556,7 @@ End Sub
 
 
 '''////  左键-多页合并一页工具   右键-批量多页居中 ////'''
-Private Sub UniteOne_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub UniteOne_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     Tools.Batch_Align_Page_Center
   ElseIf Shift = fmCtrlMask Then
@@ -613,7 +581,7 @@ Private Sub Quick_Color_Select_Click()
   Tools.quickColorSelect
 End Sub
 
-Private Sub Cut_Cake_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+Private Sub Cut_Cake_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 2 Then
     Tools.divideVertically
   ElseIf Shift = fmCtrlMask Then
@@ -624,7 +592,7 @@ Private Sub Cut_Cake_MouseDown(ByVal Button As Integer, ByVal Shift As Integer,
 End Sub
 
 '// 安全辅助线功能，三键控制，讨厌辅助线的也可以用来删除辅助线
-Private Sub Safe_Guideangle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+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 ActiveSelectionRange, 0#   ' 右键0距离贴紧
   ElseIf Shift = fmCtrlMask Then
@@ -635,16 +603,12 @@ Private Sub Safe_Guideangle_MouseDown(ByVal Button As Integer, ByVal Shift As In
 End Sub
 
 '// 标准尺寸，左键右键Ctrl三键控制，调用三种样式
-Private Sub btn_makesizes_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
+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   ' 右键
   ElseIf Shift = fmCtrlMask Then
     #If VBA7 Then
-<<<<<<< HEAD
       MakeSizePlus.Show 0
-=======
-      Woodman.Show 0
->>>>>>> c35edb3649c86cf525848e6148444292197aa8ca
     #Else  ' X4 使用
       Make_SIZE.Show 0
     #End If

UI/UniteOne.bas

@@ -1,18 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UniteOne 
-   Caption         =   "CorelDRAW 合并多页为一页 蘭雅sRGB 2010-2022"
-   ClientHeight    =   4005
-   ClientLeft      =   45
-   ClientTop       =   330
-   ClientWidth     =   5220
-   OleObjectBlob   =   "UniteOne.frx":0000
-   StartUpPosition =   1  '所有者中心
-End
-Attribute VB_Name = "UniteOne"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
 Option Explicit
 #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

UI/frmEditPowerClip.bas

@@ -1,20 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmEditPowerClip 
-   Caption         =   "容器便捷调整"
-   ClientHeight    =   3090
-   ClientLeft      =   120
-   ClientTop       =   465
-   ClientWidth     =   3510
-   OleObjectBlob   =   "frmEditPowerClip.frx":0000
-   ShowModal       =   0   'False
-   StartUpPosition =   2  '屏幕中心
-End
-Attribute VB_Name = "frmEditPowerClip"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = True
-Attribute VB_Exposed = False
-
 Option Explicit
 Dim xzbj As Boolean
 Private Sub Frame2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

UI/frmSelectSame.bas

@@ -1,19 +1,3 @@
-VERSION 5.00
-Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmSelectSame 
-   Caption         =   "Similar Selection Plus"
-   ClientHeight    =   5745
-   ClientLeft      =   495
-   ClientTop       =   5895
-   ClientWidth     =   3255
-   OleObjectBlob   =   "frmSelectSame.frx":0000
-   ShowModal       =   0   'False
-End
-Attribute VB_Name = "frmSelectSame"
-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
 

base/Sudoku.bas

@@ -0,0 +1,40 @@
+Private Sub Sudoku_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+  
+  Me.Sudoku.Visible = False
+  ' 定义九宫格方向上下左右等
+  Dim pos_x As Variant, pos_y As Variant
+  pos_x = Array(16, 16, 27, 27, 27, 16, 4, 4, 4, 16)
+  pos_y = Array(16, 4, 4, 16, 27, 27, 27, 16, 4, 16)
+  
+  If Abs(X - pos_x(0)) < 4 And Abs(Y - pos_y(0)) < 4 Then
+    Me.Sudoku.Picture = bmp0.Picture
+    
+  ElseIf Abs(X - pos_x(1)) < 4 And Abs(Y - pos_y(1)) < 4 Then
+    Me.Sudoku.Picture = bmp1.Picture
+
+  ElseIf Abs(X - pos_x(2)) < 4 And Abs(Y - pos_y(2)) < 4 Then
+    Me.Sudoku.Picture = bmp2.Picture
+
+  ElseIf Abs(X - pos_x(3)) < 4 And Abs(Y - pos_y(3)) < 4 Then
+    Me.Sudoku.Picture = bmp3.Picture
+
+  ElseIf Abs(X - pos_x(4)) < 4 And Abs(Y - pos_y(4)) < 4 Then
+    Me.Sudoku.Picture = bmp4.Picture
+    
+  ElseIf Abs(X - pos_x(5)) < 4 And Abs(Y - pos_y(5)) < 4 Then
+    Me.Sudoku.Picture = bmp5.Picture
+  
+  ElseIf Abs(X - pos_x(6)) < 4 And Abs(Y - pos_y(6)) < 4 Then
+    Me.Sudoku.Picture = bmp6.Picture
+    
+  ElseIf Abs(X - pos_x(7)) < 4 And Abs(Y - pos_y(7)) < 4 Then
+    Me.Sudoku.Picture = bmp7.Picture
+    
+  ElseIf Abs(X - pos_x(8)) < 4 And Abs(Y - pos_y(8)) < 4 Then
+    Me.Sudoku.Picture = bmp8.Picture
+    
+  End If
+  
+  Me.Sudoku.Visible = True
+End Sub
+

base/Text.bas

@@ -0,0 +1,35 @@
+Attribute VB_Name = "Module1"
+Sub 统计文本()
+  Dim s As Shape, sr As ShapeRange
+  Set sr = ActiveSelectionRange
+   
+  Dim d As Variant, str As String
+  Set d = CreateObject("Scripting.dictionary")
+  
+   For Each s In sr
+    If s.Type = cdrTextShape Then
+      str = s.text.Story.text
+      If d.Exists(str) = True Then
+        d.Item(str) = d.Item(str) + 1
+      Else
+        d.Add str, 1
+      End If
+    End If
+  Next s
+  
+
+  str = "文  本" & vbTab & vbTab & "数量" & vbNewLine
+  a = d.keys: b = d.items
+  For i = 0 To d.Count - 1
+    str = str & a(i) & vbTab & b(i) & "条" & vbNewLine
+  Next
+  str = str & "合计总量:" & vbTab & vbTab & d.Count & "条" & vbNewLine
+
+  Debug.Print str
+  
+  Dim s1 As Shape
+  x = sr.FirstShape.LeftX - 100
+  y = sr.FirstShape.TopY
+  Set s1 = ActiveLayer.CreateParagraphText(x, y, x + 90, y - 150, str, Font:="华文中宋")
+End Sub
+

donate.md

@@ -1,5 +1,5 @@
 # 捐赠网友将送商业版注册激活码一份
-![image](https://github.com/hongwenjun/corelvba/assets/1762909/b2b46a28-ba9a-4488-9c95-35e723e4022b)![](https://lyvba.com/wp-content/uploads/2023/12/vlog_lanya.jpg)
+![](https://lyvba.com/wp-content/uploads/2023/12/vlog_lanya.jpg)
 ### 2022.12.13 庆祝蘭雅CorelVBA工具捐赠和收益总额达到3000元
 ### 2023.12.29 庆祝蘭雅CorelVBA工具捐赠和收益总额达到5000元
 ## 捐赠

module/ALGO.bas

@@ -1,4 +1,3 @@
-Attribute VB_Name = "ALGO"
 '// Algorithm 模块
 #If VBA7 Then
 '// For CorelDRAW X6-2023  62bit

module/ModulePlus.bas

@@ -0,0 +1,109 @@
+Attribute VB_Name = "ModulePlus"
+'// 断开所有节点 分割线段
+Public Function SplitSegment()
+  On Error GoTo ErrorHandler
+  API.BeginOpt
+  Dim ssr As ShapeRange, s As Shape
+  Dim nr As NodeRange, nd As Node
+  
+  Set ssr = ActiveSelectionRange
+  Set s = ssr.UngroupAllEx.Combine
+  Set nr = s.Curve.Nodes.all
+  
+  nr.BreakApart
+  s.BreakApartEx
+  
+ErrorHandler:
+  API.EndOpt
+End Function
+
+'// 批量正方形 宽高统一
+Public Function square_hw(Optional ByVal hw As String = "Height")
+  API.BeginOpt
+  Set os = ActiveSelectionRange
+  Set ss = os.Shapes
+  For Each s In ss
+    If hw = "Height" Then s.SizeWidth = s.SizeHeight
+    If hw = "Width" Then s.SizeHeight = s.SizeWidth
+  Next s
+  API.EndOpt
+End Function
+
+'// 节点优化减少
+Public Function Nodes_Reduce()
+  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:
+  API.EndOpt
+End Function
+
+'// 标注线 选择文字 删除等
+Public Function Dimension_Select_or_Delete(Shift As Long)
+  On Error GoTo ErrorHandler: API.BeginOpt
+  Dim os As ShapeRange, sr As ShapeRange, s As Shape
+  Set doc = ActiveDocument
+  Set sr = ActiveSelectionRange
+  sr.RemoveAll
+
+  If Shift = 4 Then
+    Set os = ActiveSelectionRange
+    For Each s In os.Shapes
+      If s.Type = cdrTextShape Then sr.Add s
+    Next s
+  sr.CreateSelection
+  
+  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 sr.Add s
+    Next s
+    sr.Delete
+    If os.Count > 0 Then
+      os.Shapes.FindShapes(Query:="@name ='DMKLine'").CreateSelection
+      ActiveSelectionRange.Delete
+    End If
+  End If
+  
+ErrorHandler:
+  API.EndOpt
+End Function
+
+'// 解绑尺寸，分离尺寸
+Public Function Untie_MarkLines()
+  On Error GoTo ErrorHandler: API.BeginOpt
+  
+  Dim os As ShapeRange, dss As New ShapeRange
+  Set os = ActiveSelectionRange
+  For Each s In os.Shapes
+      If s.Type = cdrLinearDimensionShape Then
+        dss.Add s
+      End If
+  Next s
+  If dss.Count > 0 Then
+    dss.BreakApartEx
+    os.Shapes.FindShapes(Query:="@name ='DMKLine'").CreateSelection
+    ActiveSelectionRange.Delete
+  End If
+  
+ErrorHandler:
+  API.EndOpt
+End Function

module/SmartGroup.bas

@@ -1,4 +1,3 @@
-Attribute VB_Name = "SmartGroup"
 '// This is free and unencumbered software released into the public domain.
 '// For more information, please refer to  https://github.com/hongwenjun
 

module/StoreSelect.bas

@@ -1,4 +1,3 @@
-Attribute VB_Name = "StoreSelect"
 Private sr_mem(3) As New ShapeRange
 Public StoreCount As String
 

module/TSP.bas

@@ -1,4 +1,3 @@
-Attribute VB_Name = "TSP"
 '// 导出节点信息到数据文件
 Public Function CDR_TO_TSP()
   API.BeginOpt

module/Tools.bas

@@ -1,4 +1,3 @@
-Attribute VB_Name = "Tools"
 '// This is free and unencumbered software released into the public domain.
 '// For more information, please refer to  https://github.com/hongwenjun