X4 不支持 ShapeRange.sort 使用 lyvba32.dll 算法库排序

ALGO.bas

@@ -1,9 +1,12 @@
 Attribute VB_Name = "ALGO"
+'// This is free and unencumbered software released into the public domain.
+'// For more information, please refer to  https://github.com/hongwenjun
+
 '// Algorithm Ä£¿é
 #If VBA7 Then
 '// For CorelDRAW X6-2023  62bit
-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
+'// 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, _

API.bas

@@ -2,8 +2,6 @@ Attribute VB_Name = "API"
 '// This is free and unencumbered software released into the public domain.
 '// For more information, please refer to  https://github.com/hongwenjun
 
-'// Attribute VB_Name = "CorelVBA工具窗口启动"   CorelVBA Tool Window Launches  2023.6.11
-
 '// CorelDRAW 窗口刷新优化和关闭
 Public Function BeginOpt(Optional ByVal name As String = "Undo")
   EventsEnabled = False
@@ -200,14 +198,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#)
+    Y = aa * x + bb
+    pFootInXY = Array(x, Y, 0#)
 End Function
 
 

lines.bas

@@ -1,12 +1,12 @@
 Attribute VB_Name = "lines"
-'// 代码写到这里吧，视频结束
+'// This is free and unencumbered software released into the public domain.
+'// For more information, please refer to  https://github.com/hongwenjun
+
 Sub start()
   LinesForm.Show 0
 End Sub
 
 Public Function Nodes_DrawLines()
-  On Error GoTo ErrorHandler
-  API.BeginOpt
   Dim sr As ShapeRange, sr_tmp As New ShapeRange, sr_lines As New ShapeRange
   Dim s As Shape, sh As Shape
   Dim nr As NodeRange
@@ -28,9 +28,13 @@ Public Function Nodes_DrawLines()
     Set Line = DrawLine(sr(1), sr(2))
     sr_lines.Add Line
   End If
-  
-  sr_tmp.Sort "@shape1.left < @shape2.left"
-  
+
+#If VBA7 Then
+    sr_tmp.Sort "@shape1.left < @shape2.left"
+#Else
+    Set sr_tmp = X4_Sort_ShapeRange(sr_tmp, stlx)
+#End If
+
   '// 使用 Count 遍历 shaperange 这种情况方便点
   For i = 1 To sr_tmp.Count - 1
     Set Line = DrawLine(sr_tmp(i), sr_tmp(i + 1))
@@ -39,19 +43,15 @@ Public Function Nodes_DrawLines()
   
   sr_tmp.Delete
   sr_lines.CreateSelection
-ErrorHandler:
-  API.EndOpt
 End Function
 
-
 Public Function Draw_Multiple_Lines(hv As cdrAlignType)
-  On Error GoTo ErrorHandler
-  API.BeginOpt
   Dim sr As ShapeRange, sr_lines As New ShapeRange
   Set sr = ActiveSelectionRange
   
   If sr.Count < 2 Then Exit Function
   
+#If VBA7 Then
   If hv = cdrAlignVCenter Then
     '// 从左到右排序
     sr.Sort "@shape1.left < @shape2.left"
@@ -59,18 +59,24 @@ Public Function Draw_Multiple_Lines(hv As cdrAlignType)
     '// 从上到下排序
     sr.Sort "@shape1.top < @shape2.top"
   End If
-  
+#Else
+  '// X4_Sort_ShapeRange for CorelDRAW X4
+  If hv = cdrAlignVCenter Then
+    Set sr = X4_Sort_ShapeRange(sr, stlx)
+  ElseIf hv = cdrAlignHCenter Then
+    Set sr = X4_Sort_ShapeRange(sr, stty)
+  End If
+ 
+#End If
+
   For i = 1 To sr.Count - 1 Step 2
     Set Line = DrawLine(sr(i), sr(i + 1))
     sr_lines.Add Line
   Next
  
   sr_lines.CreateSelection
-ErrorHandler:
-  API.EndOpt
 End Function
 
-
 Public Function FirtLineTool()
   Dim sr As ShapeRange
   Set sr = ActiveSelectionRange
@@ -85,15 +91,9 @@ Private Function DrawLine(ByVal s1 As Shape, ByVal s2 As Shape) As Shape
 
 End Function
 
-
-
-
-Sub Test()
+Private Sub Test()
   ActiveDocument.Unit = cdrMillimeter
-
- Set Rect = ActiveLayer.CreateRectangle(0, 0, 30, 30)
- Set ell = ActiveLayer.CreateEllipse2(50, 50, 10, 10)
-
- Set Line = DrawLine(Rect, ell)
-
+  Set Rect = ActiveLayer.CreateRectangle(0, 0, 30, 30)
+  Set ell = ActiveLayer.CreateEllipse2(50, 50, 10, 10)
+  Set Line = DrawLine(Rect, ell)
 End Sub