浏览代码

ArrangeForm ready for translation

Hongwenjun 1 年之前
父节点
当前提交
9bb1a5362f
共有 1 个文件被更改,包括 19 次插入30 次删除
  1. 19 30
      UI/ArrangeForm.bas

+ 19 - 30
UI/ArrangeForm.bas

@@ -1,6 +1,6 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ArrangeForm 
-   Caption         =   "蘭雅sRGB 手动拼版 │ 嘉盟赞助"
+   Caption         =   "蘭雅sRGB 手动拼版"
    ClientHeight    =   2475
    ClientLeft      =   45
    ClientTop       =   330
@@ -16,15 +16,12 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
-
-
 Private Sub CommandButton1_Click()
   On Error GoTo ErrorHandler
-  ActiveDocument.Unit = cdrMillimeter
-  Dim ls As Integer, hs As Integer
-  Dim lj As Double, hj As Double
-  Dim matrix As Variant
-  Dim s As ShapeRange
+  API.BeginOpt
+  
+  Dim ls, hs As Integer: Dim lj, hj As Double
+  Dim matrix As Variant: Dim sr As ShapeRange
   
   ls = Val(TextBox1.text)
   hs = Val(TextBox2.text)
@@ -32,52 +29,44 @@ Private Sub CommandButton1_Click()
   hj = Val(TextBox4.text)
   matrix = Array(ls, hs, lj, hj)
   
-  Set s = ActiveSelectionRange
+  Set sr = ActiveSelectionRange
 
   If ls * hs = 0 Then Exit Sub
   If ls = 1 Or hs = 1 Then
-    arrange_Clone_one matrix, s
-    Exit Sub
+    arrange_Clone_one matrix, sr
+    GoTo ErrorHandler
   End If
   
   '// 代码运行时关闭窗口刷新
   ActiveDocument.BeginCommandGroup:  Application.Optimization = True
   '// 拼版矩阵
-  arrange_Clone matrix, s
-
-  ActiveDocument.EndCommandGroup
+  arrange_Clone matrix, sr
   Unload Me
   
-  '// 代码操作结束恢复窗口刷新
-  ActiveDocument.EndCommandGroup
-  Application.Optimization = False
-  ActiveWindow.Refresh:    Application.Refresh
-  Exit Sub
 ErrorHandler:
-  Application.Optimization = False
-  On Error Resume Next
+  API.EndOpt
 End Sub
 
-'// 拼版矩阵  matrix = Array(ls,hs,lj,hj)
-Private Function arrange_Clone(matrix As Variant, s As ShapeRange)
+'// 拼版矩阵  matrix = Array(ls, hs, lj, hj)
+Private Function arrange_Clone(matrix As Variant, sr As ShapeRange)
   ls = matrix(0): hs = matrix(1)
   lj = matrix(2): hj = matrix(3)
-  X = s.SizeWidth: Y = s.SizeHeight
-  Set s1 = s.Clone
+  x = sr.SizeWidth: Y = sr.SizeHeight
+  Set s1 = sr.Clone
   '// StepAndRepeat 方法在范围内创建多个形状副本
-  Set dup1 = s1.StepAndRepeat(ls - 1, X + lj, 0#)
+  Set dup1 = s1.StepAndRepeat(ls - 1, x + lj, 0#)
   Set dup2 = ActiveDocument.CreateShapeRangeFromArray(dup1, s1).StepAndRepeat(hs - 1, 0#, -(Y + hj))
   s1.Delete
 End Function
 
-Private Function arrange_Clone_one(matrix As Variant, s As ShapeRange)
+Private Function arrange_Clone_one(matrix As Variant, sr As ShapeRange)
   ls = matrix(0): hs = matrix(1)
   lj = matrix(2): hj = matrix(3)
-  X = s.SizeWidth: Y = s.SizeHeight
-  Set s1 = s.Clone
+  x = sr.SizeWidth: Y = sr.SizeHeight
+  Set s1 = sr.Clone
   '// StepAndRepeat 方法在范围内创建多个形状副本
   If ls > 1 Then
-    Set dup1 = s1.StepAndRepeat(ls - 1, X + lj, 0#)
+    Set dup1 = s1.StepAndRepeat(ls - 1, x + lj, 0#)
   Else
     Set dup1 = s1
   End If