Object Model Reference : Classes : S : Shape : Properties : Shape.OverprintFill
|
|
| Object Model Reference : Classes : S : Shape : Properties : Shape.OverprintFill |
Property OverprintFill As Boolean
Member of Shape
The OverprintFill property returns or specifies whether to overprint the fill of an object.
The following VBA example previews overprinted fills in the drawing by creating additional objects where two or more shapes intersect. These new objects are filled with the appropriate resultant colors. There must be at least two overlapping shapes in the document.
' Previews fill overprints on screen |
Public Sub CreateOverprint() |
Dim n1 As Long |
Dim n2 As Long |
Dim s1 As Shape |
Dim s2 As Shape |
Dim s As Shape |
Dim shps As Shapes |
Dim c1 As New color |
Dim c2 As New color |
ActiveDocument.ReferencePoint = cdrBottomLeft |
ActiveDocument.ShapeEnumDirection = cdrShapeEnumBottomFirst |
' Look through all shapes from bottom to top |
Set shps = ActivePage.Shapes |
For n1 = 1 To shps.Count - 1 |
Set s1 = shps(n1) |
If s1.Fill.Type = cdrUniformFill Then |
' If the shape has a uniform fill, get its color |
c1.CopyAssign s1.Fill.UniformColor |
' Check all shapes above it |
For n2 = n1 + 1 To shps.Count |
Set s2 = shps(n2) |
If s2.Fill.Type = cdrUniformFill And s2.OverprintFill Then |
' If the shape has a uniform fill has Overprint fill specified, |
' get its color |
c2.CopyAssign s2.Fill.UniformColor |
If Overlap(s1, s2) Then |
' If the shapes may overlap, mix the two colors and ... |
MixColors c1, c2 |
' ... create the intersecting shape |
Set s = s1.Intersect(s2) |
If Not s Is Nothing Then |
' If anything was generated during intersection, |
' apply the resulting color to it and mark the shape with |
' overprint fill attribute for future processing |
s.Fill.ApplyUniformFill c2 |
s.OverprintFill = True |
End If |
End If |
End If |
Next n2 |
End If |
Next n1 |
End Sub |
' Determines if the two shapes may overlap |
Private Function Overlap(s1 As Shape, s2 As Shape) As Boolean |
Dim x1 As Double, y1 As Double, w1 As Double, h1 As Double |
Dim x2 As Double, y2 As Double, w2 As Double, h2 As Double |
s1.GetBoundingBox x1, y1, w1, h1 |
s2.GetBoundingBox x2, y2, w2, h2 |
Overlap = Not (x1 + w1 < x2 Or x2 + w2 < x1 Or y1 + h1 < y2 Or y2 + h2 < y1) |
End Function |
' Mixes two colors according to their inks |
Private Sub MixColors(c1 As color, c2 As color) |
Dim cc1 As New color |
Dim bSpot As Boolean |
cc1.CopyAssign c1 |
If cc1.Type <> cdrColorCMYK Then cc1.ConvertToCMYK |
bSpot = (c1.Type = cdrColorSpot Or c1.Type = cdrColorPantone Or _ |
c2.Type = cdrColorSpot Or c2.Type = cdrColorPantone) |
If c2.Type <> cdrColorCMYK Then c2.ConvertToCMYK |
If Not bSpot Then |
' If we are mixing process colors, only replace the color channels that |
' have no color in the top shape |
If c2.CMYKBlack = 0 Then c2.CMYKBlack = cc1.CMYKBlack |
If c2.CMYKCyan = 0 Then c2.CMYKCyan = cc1.CMYKCyan |
If c2.CMYKMagenta = 0 Then c2.CMYKMagenta = cc1.CMYKMagenta |
If c2.CMYKYellow = 0 Then c2.CMYKYellow = cc1.CMYKYellow |
Else |
' If we are mixing spot colors, just add inks |
c2.CMYKBlack = GetMaxInk(cc1.CMYKBlack + c2.CMYKBlack) |
c2.CMYKCyan = GetMaxInk(cc1.CMYKCyan + c2.CMYKCyan) |
c2.CMYKMagenta = GetMaxInk(cc1.CMYKMagenta + c2.CMYKMagenta) |
c2.CMYKYellow = GetMaxInk(cc1.CMYKYellow + c2.CMYKYellow) |
End If |
End Sub |
' Makes sure the ink level doesn't exceed 100% |
Private Function GetMaxInk(Ink As Long) As Long |
Dim n As Long |
n = Ink |
If n > 100 Then n = 100 |
GetMaxInk = n |
End Function |
|
|
|
|
Copyright 2013 Corel Corporation. All rights reserved.