1
1

ArrangeForm.frm 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138
  1. VERSION 5.00
  2. Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ArrangeForm
  3. Caption = "Matrix Arrange"
  4. ClientHeight = 2475
  5. ClientLeft = 45
  6. ClientTop = 330
  7. ClientWidth = 4650
  8. OleObjectBlob = "ArrangeForm.frx":0000
  9. ShowModal = 0 'False
  10. StartUpPosition = 2 'CenterScreen
  11. WhatsThisButton = -1 'True
  12. WhatsThisHelp = -1 'True
  13. End
  14. Attribute VB_Name = "ArrangeForm"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = False
  17. Attribute VB_PredeclaredId = True
  18. Attribute VB_Exposed = False
  19. '// 用户窗口初始化
  20. Private Sub UserForm_Initialize()
  21. ActiveDocument.Unit = cdrMillimeter
  22. Dim sr As ShapeRange
  23. Dim ls, hs, lj, hj, pw, ph As Double
  24. pw = ActiveDocument.Pages.First.SizeWidth
  25. ph = ActiveDocument.Pages.First.SizeHeight
  26. TextBox1.text = 2
  27. TextBox2.text = 5
  28. TextBox3.text = 0
  29. TextBox4.text = 0
  30. LNG_CODE = API.GetLngCode
  31. Me.Caption = i18n("Matrix Arrange", LNG_CODE)
  32. Me.Frame1.Caption = i18n("Set Matrix", LNG_CODE)
  33. Init_Translations Me, LNG_CODE
  34. Set sr = ActiveSelectionRange
  35. If sr.Count > 0 Then
  36. ls = Int(sr.SizeWidth + 0.5)
  37. hs = Int(sr.SizeHeight + 0.5)
  38. If LNG_CODE = 1033 Then
  39. Label_Size.Caption = "Size: " & ls & "x" & hs & "mm"
  40. Else
  41. Label_Size.Caption = "尺寸: " & ls & "×" & hs & "mm"
  42. End If
  43. lj = Int(pw / ls)
  44. hj = Int(ph / hs)
  45. Dim jh, jl, t As Double
  46. jl = Int(pw / hs)
  47. jh = Int(ph / ls)
  48. '// Debug.Print lj, hj, jl, jh
  49. If jh * jl > hj * lj Then
  50. lj = jl
  51. hj = jh
  52. If lj * ls > pw Or hj * hs > ph Then
  53. t = lj
  54. lj = hj
  55. hj = t
  56. End If
  57. End If
  58. TextBox1.text = lj
  59. TextBox2.text = hj
  60. End If
  61. End Sub
  62. Private Sub CommandButton1_Click()
  63. On Error GoTo ErrorHandler
  64. API.BeginOpt
  65. Dim ls, hs As Integer: Dim lj, hj As Double
  66. Dim Matrix As Variant: Dim sr As ShapeRange
  67. ls = Val(TextBox1.text)
  68. hs = Val(TextBox2.text)
  69. lj = Val(TextBox3.text)
  70. hj = Val(TextBox4.text)
  71. Matrix = Array(ls, hs, lj, hj)
  72. Set sr = ActiveSelectionRange
  73. If ls * hs = 0 Then Exit Sub
  74. If ls = 1 Or hs = 1 Then
  75. arrange_Clone_one Matrix, sr
  76. GoTo ErrorHandler
  77. End If
  78. '// 代码运行时关闭窗口刷新
  79. ActiveDocument.BeginCommandGroup: Application.Optimization = True
  80. '// 拼版矩阵
  81. arrange_Clone Matrix, sr
  82. Unload Me
  83. ErrorHandler:
  84. API.EndOpt
  85. End Sub
  86. '// 拼版矩阵 matrix = Array(ls, hs, lj, hj)
  87. Private Function arrange_Clone(Matrix As Variant, sr As ShapeRange)
  88. ls = Matrix(0): hs = Matrix(1)
  89. lj = Matrix(2): hj = Matrix(3)
  90. X = sr.SizeWidth: Y = sr.SizeHeight
  91. Set s1 = sr '// Set s1 = sr.Clone
  92. '// StepAndRepeat 方法在范围内创建多个形状副本
  93. '// Set dup1 = s1.StepAndRepeat(ls - 1, x + lj, 0#)
  94. '// Set dup2 = ActiveDocument.CreateShapeRangeFromArray(dup1, s1).StepAndRepeat(hs - 1, 0#, -(Y + hj))
  95. Set dup1 = s1.StepAndRepeat(hs - 1, 0#, -(Y + hj))
  96. Set dup2 = ActiveDocument.CreateShapeRangeFromArray(dup1, s1).StepAndRepeat(ls - 1, X + lj, 0#)
  97. '// s1.Delete
  98. End Function
  99. Private Function arrange_Clone_one(Matrix As Variant, sr As ShapeRange)
  100. ls = Matrix(0): hs = Matrix(1)
  101. lj = Matrix(2): hj = Matrix(3)
  102. X = sr.SizeWidth: Y = sr.SizeHeight
  103. Set s1 = sr '// Set s1 = sr.Clone
  104. '// StepAndRepeat 方法在范围内创建多个形状副本
  105. If ls > 1 Then
  106. Set dup1 = s1.StepAndRepeat(ls - 1, X + lj, 0#)
  107. Else
  108. Set dup1 = s1
  109. End If
  110. If hs > 1 Then
  111. Set dup2 = ActiveDocument.CreateShapeRangeFromArray(dup1, s1).StepAndRepeat(hs - 1, 0#, -(Y + hj))
  112. End If
  113. '// s1.Delete
  114. End Function