1
1

ALGO.bas 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. Attribute VB_Name = "ALGO"
  2. '// Algorithm 模块
  3. #If VBA7 Then
  4. '// For CorelDRAW X6-2023 62bit
  5. Public Declare PtrSafe Function i18n Lib "C:\TSP\lyvba.dll" (ByVal str As String, ByVal code As Long) As String
  6. Private Declare PtrSafe Function sort_byitem Lib "C:\TSP\lyvba.dll" (ByRef sr_Array As ShapeProperties, ByVal size As Long, _
  7. ByVal Sort_By As SortItem, ByRef ret_Array As Long) As Long
  8. #Else
  9. '// For CorelDRAW X4 32bit
  10. Declare Function i18n Lib "C:\TSP\lyvba32.dll" (ByVal str As String, ByVal code As Long) As String
  11. Declare Function sort_byitem Lib "C:\TSP\lyvba32.dll" (ByRef sr_Array As ShapeProperties, ByVal size As Long, _
  12. ByVal Sort_By As SortItem, ByRef ret_Array As Long) As Long
  13. #End If
  14. Type ShapeProperties
  15. Item As Long '// ShapeRange.Item
  16. StaticID As Long '// Shape.StaticID
  17. lx As Double: rx As Double '// s.LeftX s.RightX s.BottomY s.TopY
  18. by As Double: ty As Double
  19. cx As Double: cy As Double '// s.CenterX s.CenterY s.SizeWidth s.SizeHeight
  20. sw As Double: sh As Double
  21. End Type
  22. Enum SortItem
  23. stlx
  24. strx
  25. stby
  26. stty
  27. stcx
  28. stcy
  29. stsw
  30. stsh
  31. Area
  32. topWt_left
  33. End Enum
  34. Public LNG_CODE As Long
  35. Private Sub Test_Sort_ShapeRange()
  36. API.BeginOpt
  37. Dim sr As ShapeRange, ssr As ShapeRange
  38. Dim s As Shape
  39. Set sr = ActiveSelectionRange
  40. Set ssr = ShapeRange_To_Sort_Array(sr, topWt_left)
  41. '// s 调整次序
  42. For Each s In ssr
  43. s.OrderToFront
  44. Next s
  45. MsgBox "ShapeRange_SortItem:" & " " & topWt_left & " 枚举值"
  46. API.EndOpt
  47. End Sub
  48. Public Function X4_Sort_ShapeRange(ByRef sr As ShapeRange, ByRef Sort_By As SortItem) As ShapeRange
  49. Set X4_Sort_ShapeRange = ShapeRange_To_Sort_Array(sr, Sort_By)
  50. End Function
  51. Public Function sorted(ByRef sr As ShapeRange, ByRef Sort_By As SortItem) As ShapeRange
  52. Set sorted = ShapeRange_To_Sort_Array(sr, Sort_By)
  53. End Function
  54. '// 映射 ShapeRange 到 Array 然后调用 DLL库排序
  55. Private Function ShapeRange_To_Sort_Array(ByRef sr As ShapeRange, ByRef Sort_By As SortItem) As ShapeRange
  56. On Error GoTo ErrorHandler
  57. Dim sp As ShapeProperties
  58. Dim size As Long, ret As Long
  59. Dim s As Shape
  60. size = sr.Count
  61. Dim sr_Array() As ShapeProperties
  62. Dim ret_Array() As Long
  63. ReDim ret_Array(1 To size)
  64. ReDim sr_Array(1 To size)
  65. For Each s In sr
  66. sp.Item = sr.IndexOf(s)
  67. sp.StaticID = s.StaticID
  68. sp.lx = s.LeftX: sp.rx = s.RightX
  69. sp.by = s.BottomY: sp.ty = s.TopY
  70. sp.cx = s.CenterX: sp.cy = s.CenterY
  71. sp.sw = s.SizeWidth: sp.sh = s.SizeHeight
  72. sr_Array(sp.Item) = sp
  73. Next s
  74. '// 在VBA中数组的索引从1开始, 将数组的地址传递给函数需要Arr(1)方式
  75. '// C/C++ 函数定义 int __stdcall SortByItem(ShapeProperties* sr_Array, int size, SortItem Sort_By, int* ret_Array)
  76. '// sr_Array首地址,size 长度, Sort_By 排序方式, 返回数组 ret_Array
  77. ret = sort_byitem(sr_Array(1), size, Sort_By, ret_Array(1))
  78. ' Debug.Print ret, size
  79. If ret = size Then
  80. Dim srcp As New ShapeRange, i As Integer
  81. For i = 1 To size
  82. srcp.Add sr(ret_Array(i))
  83. ' Debug.Print i
  84. Next i
  85. Set ShapeRange_To_Sort_Array = srcp
  86. End If
  87. ErrorHandler:
  88. End Function
  89. Private Sub Test_i18n()
  90. MsgBox i18n("Nodes", 2052)
  91. MsgBox i18n("Nodes", 1033)
  92. MsgBox i18n("Preset Property", 2052)
  93. End Sub
  94. Public Function Init_Translations(frm As UserForm, code As Long)
  95. Dim ctl As Variant: Dim en As String
  96. LNG_CODE = code
  97. For Each ctl In frm.Controls
  98. 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
  99. If Not IsNull(ctl.Caption) And ctl.Caption <> "" Then
  100. en = ctl.Caption
  101. ctl.Caption = i18n(en, LNG_CODE)
  102. End If
  103. If Not IsNull(ctl.ControlTipText) And ctl.ControlTipText <> "" Then
  104. en = ctl.ControlTipText
  105. ctl.ControlTipText = i18n(en, LNG_CODE)
  106. End If
  107. End If
  108. Next ctl
  109. End Function