edit R5

add make color bar in new document
CheckTech · Dec 7, 2016 · 9a83450 · 9a83450
1 parent 78e125a
commit 9a83450
Show file tree

Hide file tree

Showing 11 changed files with 648 additions and 28 deletions.
diff --git a/PrintMarksR5.frm b/PrintMarksR5.frm
diff --git a/PrintMarksR5.frx b/PrintMarksR5.frx
diff --git a/PrintMarksR5v2.bas b/PrintMarksR5v2.bas
@@ -0,0 +1,71 @@
+Attribute VB_Name = "PrintMarksR5v2"
+Sub showForm()
+    If (Documents.Count = 0) Then Exit Sub
+    PrintMarksR5.Show vbModeles
+End Sub
+
+Public Sub PrintMarksR5v2(sColorBar As Shape, signColor As Shape)
+    Dim itemColorBar As Shape
+    Dim colorBar As New ShapeRange, finalColorBar As New ShapeRange, srD As New ShapeRange
+    Dim leftOffsetMark As New ShapeRange
+    Dim rightOffsetMark As New ShapeRange
+    Dim leftTargetMark As New ShapeRange
+    Dim rightTargetMark As New ShapeRange
+    Dim leftMark As New ShapeRange
+    Dim printMarksPath As String
+    Dim offsetLeftMark As Integer, offsetTargetMark As Integer
+    Dim allMarks As New ShapeRange
+
+    printMarksPath = (UserDataPath & "printMarks\")
+    offsetLeftMark = 55
+    offsetTargetMark = 15
+
+    colorBar.Add sColorBar
+
+    ActiveLayer.Import (printMarksPath & "leftOffsetMark.cdr")
+    Set leftOffsetMark = ActiveSelectionRange
+    ActiveLayer.Import (printMarksPath & "rightOffsetMark.cdr")
+    Set rightOffsetMark = ActiveSelectionRange
+    ActiveLayer.Import (printMarksPath & "targetMark.cdr")
+    Set leftTargetMark = ActiveSelectionRange
+    Set rightTargetMark = leftTargetMark.Duplicate
+    ActiveLayer.Import (printMarksPath & "leftMark.cdr")
+    Set leftMark = ActiveSelectionRange
+    Set finalColorBar = New ShapeRange
+
+    leftOffsetMark.PositionX = ActivePage.BoundingBox.Left
+    leftOffsetMark.PositionY = ActivePage.BoundingBox.Top
+    rightOffsetMark.PositionX = ActivePage.BoundingBox.Right - rightOffsetMark.BoundingBox.Width
+    rightOffsetMark.PositionY = ActivePage.BoundingBox.Top
+    leftMark.PositionX = ActivePage.BoundingBox.Left
+    leftMark.PositionY = ActivePage.BoundingBox.Top - offsetLeftMark
+    leftTargetMark.PositionX = ActivePage.BoundingBox.Left
+    leftTargetMark.PositionY = ActivePage.BoundingBox.Bottom + offsetTargetMark
+    rightTargetMark.PositionX = ActivePage.BoundingBox.Right - rightTargetMark.BoundingBox.Width
+    rightTargetMark.PositionY = ActivePage.BoundingBox.Bottom + offsetTargetMark
+    colorBar.CenterX = ActivePage.BoundingBox.CenterX
+    colorBar.PositionY = ActivePage.BoundingBox.Bottom + colorBar.BoundingBox.Height
+    signColor.Rotate 90
+    signColor.PositionX = leftTargetMark.BoundingBox.CenterX - signColor.BoundingBox.Width / 2
+    signColor.PositionY = leftTargetMark.BoundingBox.Bottom + signColor.BoundingBox.Height + offsetTargetMark
+
+    colorBar.Ungroup
+    For Each itemColorBar In colorBar
+        If (itemColorBar.BoundingBox.Left > ActivePage.BoundingBox.Left) And (itemColorBar.BoundingBox.Right < ActivePage.BoundingBox.Right) Then
+            finalColorBar.Add itemColorBar
+        End If
+    Next itemColorBar
+    Set srD = finalColorBar.Duplicate
+    colorBar.Delete
+
+    Set itemColorBar = srD.Group
+    itemColorBar.AddToSelection
+    leftOffsetMark.AddToSelection
+    rightOffsetMark.AddToSelection
+    leftMark.AddToSelection
+    leftTargetMark.AddToSelection
+    rightTargetMark.AddToSelection
+    signColor.AddToSelection
+    ActiveSelectionRange.Group.Copy
+End Sub
+
diff --git a/frmCutMarks.frm b/frmCutMarks.frm
@@ -77,7 +77,7 @@ End Sub
 
 Private Sub drawMark(startX As Double, startY As Double, endX As Double, endY As Double)
     Dim mark As Shape
-    Dim whiteColor As New color
+    Dim whiteColor As New Color
     whiteColor.CMYKAssign 0, 0, 0, 0
     If cbWhiteSpace Then
         Set mark = ActiveLayer.CreateLineSegment(startX, startY, endX, endY)

diff --git a/frmCutMarks.frx b/frmCutMarks.frx
diff --git a/frmExportAll.frm b/frmExportAll.frm
@@ -1,7 +1,7 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmExportAll 
    Caption         =   "Export All v2.01"
-   ClientHeight    =   2940
+   ClientHeight    =   3135
    ClientLeft      =   45
    ClientTop       =   435
    ClientWidth     =   3735
@@ -27,6 +27,7 @@ Private Sub cbExecute_Click()
     Dim doc As Document
     Dim aPage As Page
     Dim iPage As Integer
+    Dim expArea As Rect
 
     colorSpaceField = cboColorSpace.Text
     resolution = cboResolution.Text
@@ -40,13 +41,19 @@ Private Sub cbExecute_Click()
             filePath = doc.filePath
             fileName = Left(fileName, (Len(fileName) - 4))
             iPage = 0
+            doc.MasterPage.GuidesLayer.Editable = False
             For Each aPage In doc.Pages
                 aPage.Activate
+                aPage.GuidesLayer.Editable = False
                 iPage = iPage + 1
                 fullFileName = filePath + fileName + "_" & iPage & "_" + aPage.Name + ".jpg"
                 aPage.Shapes.All.CreateSelection
                 If (aPage.SelectableShapes.Count > 0) Then
-                    Set expFilter = doc.ExportBitmap(fullFileName, cdrJPEG, cdrSelection, colorSpace, 0, 0, resolution, resolution, cdrNormalAntiAliasing, False, False, chbProfile.Value, False, cdrCompressionNone)
+                    Set expArea = activeSelection.BoundingBox.GetCopy
+                    If cbPageBox.Value Then
+                        Set expArea = aPage.BoundingBox.GetCopy
+                    End If
+                    Set expFilter = doc.ExportBitmap(fullFileName, cdrJPEG, cdrCurrentPage, colorSpace, 0, 0, resolution, resolution, cdrNormalAntiAliasing, False, False, chbProfile.Value, False, cdrCompressionNone, , expArea)
                     With expFilter
                         .Progressive = False
                         .Optimized = False
@@ -64,13 +71,19 @@ Private Sub cbExecute_Click()
         filePath = doc.filePath
         fileName = Left(fileName, (Len(fileName) - 4))
         iPage = 0
+        doc.MasterPage.GuidesLayer.Editable = False
         For Each aPage In doc.Pages
             aPage.Activate
+            aPage.GuidesLayer.Editable = False
             iPage = iPage + 1
             fullFileName = filePath + fileName + "_" & iPage & "_" + aPage.Name + ".jpg"
             aPage.Shapes.All.CreateSelection
             If (aPage.SelectableShapes.Count > 0) Then
-                Set expFilter = doc.ExportBitmap(fullFileName, cdrJPEG, cdrSelection, colorSpace, 0, 0, resolution, resolution, cdrNormalAntiAliasing, False, False, chbProfile.Value, False, cdrCompressionNone)
+                Set expArea = activeSelection.BoundingBox.GetCopy
+                If cbPageBox.Value Then
+                    Set expArea = aPage.BoundingBox.GetCopy
+                End If
+                Set expFilter = doc.ExportBitmap(fullFileName, cdrJPEG, cdrCurrentPage, colorSpace, 0, 0, resolution, resolution, cdrNormalAntiAliasing, False, False, chbProfile.Value, False, cdrCompressionNone, , expArea)
                 With expFilter
                     .Progressive = False
                     .Optimized = False
@@ -94,6 +107,10 @@ Private Sub cbCancel_Click()
     Unload Me
 End Sub
 
+Private Sub cbPageBox_Click()
+
+End Sub
+
 Private Sub UserForm_Initialize()
     cboResolution.AddItem "72"
     cboResolution.AddItem "150"

diff --git a/frmExportAll.frx b/frmExportAll.frx
diff --git a/frmMakeOnAllPages.frm b/frmMakeOnAllPages.frm
@@ -14,85 +14,113 @@ Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 Private Sub btnGroup_Click()
-    Application.Optimization = True
+ActiveDocument.BeginCommandGroup "Make on All Pages"
+Application.Optimization = True
+
     Dim aPage As Page
     For Each aPage In ActiveDocument.Pages
         aPage.Activate
         InfUtilits.GroupAll.GroupAll
     Next aPage
     ActiveDocument.Pages(1).Activate
-    Application.Optimization = False
-    ActiveWindow.Refresh
-    Application.Refresh
+
+Application.Optimization = False
+ActiveWindow.Refresh
+Application.Refresh
+ActiveDocument.EndCommandGroup
     Unload Me
 End Sub
 
 Private Sub btnOffset10_Click()
-    Application.Optimization = True
+ActiveDocument.BeginCommandGroup "Offset Shape 10 mm"
+Application.Optimization = True
+
     Dim aPage As Page
     For Each aPage In ActiveDocument.Pages
         aPage.Activate
         InfUtilits.OffsetAllShapes.OffsetAllShapes10
     Next aPage
     ActiveDocument.Pages(1).Activate
-    Application.Optimization = False
-    ActiveWindow.Refresh
-    Application.Refresh
+
+Application.Optimization = False
+ActiveWindow.Refresh
+Application.Refresh
+ActiveDocument.EndCommandGroup
     Unload Me
 End Sub
 
 Private Sub btnOffset12_Click()
-    Application.Optimization = True
+ActiveDocument.BeginCommandGroup "Offset Shape 12 mm"
+Application.Optimization = True
+
     Dim aPage As Page
     For Each aPage In ActiveDocument.Pages
         aPage.Activate
         InfUtilits.OffsetAllShapes.OffsetAllShapes12
     Next aPage
     ActiveDocument.Pages(1).Activate
-    Application.Optimization = False
-    ActiveWindow.Refresh
-    Application.Refresh
+
+Application.Optimization = False
+ActiveWindow.Refresh
+Application.Refresh
+ActiveDocument.EndCommandGroup
     Unload Me
 End Sub
 
 Private Sub btnPowerClip_Click()
-    Application.Optimization = True
+ActiveDocument.BeginCommandGroup "Place to Power Clip"
+Application.Optimization = True
+
     Dim aPage As Page
     For Each aPage In ActiveDocument.Pages
         aPage.Activate
         InfUtilits.PlaceAllToPowerClip.PlaceAllToPowerClip
     Next aPage
     ActiveDocument.Pages(1).Activate
-    Application.Optimization = False
-    ActiveWindow.Refresh
-    Application.Refresh
+
+Application.Optimization = False
+ActiveWindow.Refresh
+Application.Refresh
+ActiveDocument.EndCommandGroup
     Unload Me
 End Sub
 
 Private Sub btnPrintMarksR5_Click()
-    Application.Optimization = True
+ActiveDocument.BeginCommandGroup "Create R5 Print Marks"
+Application.Optimization = True
+
     Dim aPage As Page
     For Each aPage In ActiveDocument.Pages
         aPage.Activate
         InfUtilits.PrintMarksR5.PrintMarksR5
     Next aPage
     ActiveDocument.Pages(1).Activate
-    Application.Optimization = False
-    ActiveWindow.Refresh
-    Application.Refresh
+
+Application.Optimization = False
+ActiveWindow.Refresh
+Application.Refresh
+ActiveDocument.EndCommandGroup
     Unload Me
 End Sub
 
 Private Sub btnPrintMarksR7_Click()
-    Application.Optimization = True
+ActiveDocument.BeginCommandGroup "Create R5 Print Marks"
+Application.Optimization = True
+
     Dim aPage As Page
     For Each aPage In ActiveDocument.Pages
         aPage.Activate
         InfUtilits.PrintMarksR7.PrintMarksR7
     Next aPage
     ActiveDocument.Pages(1).Activate
-    Application.Optimization = False
-    ActiveWindow.Refresh
-    Application.Refresh
+
+Application.Optimization = False
+ActiveWindow.Refresh
+Application.Refresh
+ActiveDocument.EndCommandGroup
     Unload Me
 End Sub
+
+Private Sub UserForm_Click()
+
+End Sub
diff --git a/frmMakeOnAllPages.frx b/frmMakeOnAllPages.frx
diff --git a/frmPrintSign.frx b/frmPrintSign.frx
diff --git a/gms/InfUtilits.gms b/gms/InfUtilits.gms