Как запомнить наложенную на Shape прозрачность

CrazyMaxTM · 01.02.2007

Я пишу скрипт на VBA для CorelDraw 12. В нем необходимо запомнить состояние выделенного рисунка (координаты, скос, поворот, наложенную на него прозрачность и т.п.) затем сбросить все эффекты и трансформации и сохранить его на диск в «чистом неискаженном виде» после чего требуется вернуть исходное состояние. Ну с позицией и искажениями я справился, благо есть такая вещь как матрица трансформации, а вот с наложенной прозрачностью беда! Мало того что существует несколько видов самой прозрачности так еще и свойств у них туева хуча и у каждой разные!
В связи с эти у меня возник вопрос:
Можно ли все свойства одного объекта одним разом запомнить в другом объекте того же типа при помощи одного выражения, ну типа x=y, или для этого требуется присваивать каждое свойство отдельно? Я пробовал писать типа obj_2=obj_1 бесполезно, в obj_2 копируется ссылка на obj_1 после чего они представляют один и тот же объект. В результате изменение свойств obj_1 влечет такое же изменение в obj_2
К сожалению я не слишком силен в VBA и в объектно ориентированном программировании подскажите плиззз, если кто разбирается.

wOxxOm · 01.02.2007

Ответ: Как запомнить наложенную на Shape прозрачность

1. пощадите чувства Lev - в ВБА пишутся макросы а не скрипты
2. способа копировать сложные прозрачности и другие усложненные настройками эффекты через ВБА , к сожалению, не существует. Имеющийся остаток в виде CorelScript.CopyEffectsFrom не поддерживает новые эффекты, в т.ч. тень, прозрачность

dizzy · 02.02.2007

Ответ: Как запомнить наложенную на Shape прозрачность

Товарищ, а Вы случаем не изобретаете как из корела в шопе фотки открывать? Если так, то макрос уже готов. Терпения запаститесь чуток, скора выложу в сеть. Если нет - могу выложить свое решение, правда очень интересно для чего еще оно могло понадобится...

lev · 02.02.2007

Ответ: Как запомнить наложенную на Shape прозрачность

а Вы случаем не изобретаете как из корела в шопе фотки открывать

Больше похоже на программную запись и последуещее воссоздание уже существующего документа. Может пригодится, например, для запароливания документа - пока пароль не введен - документ не существует, а после введения пароля рисуется макросом с нуля. Подобный код можно использовать и для создания собственных "фильтров" импорта, и т.д., и т.п.

dizzy · 02.02.2007

Ответ: Как запомнить наложенную на Shape прозрачность

Да пожалуйста, я не жадный:

Код:

Sub GetSetShape(shIs As Shape, shTo As Shape)
On Error Resume Next
Dim d11 As Double, d12 As Double, d21 As Double, d22 As Double, X As Double, Y As Double, W As Double, H As Double
Dim tx As Double, ty As Double, shIsCurve As Curve, s As Shape, c As Color
    If shIs.Bitmap.CropEnvelopeModified Then
        Set shIsCurve = shIs.Bitmap.CropEnvelope
        Set s = ActiveLayer.CreateCurve(shIsCurve)
        s.Outline.width = 0
        shIs.Bitmap.ResetCropEnvelope
        shIs.GetPosition X, Y
        shIs.GetMatrix d11, d12, d21, d22, tx, ty
        shIs.GetSize W, H
        ActiveDocument.Undo
        
        shTo.SetMatrix d11, d12, d21, d22, tx, ty
        shTo.SetSize W, H
        shTo.SetPosition X, Y
        Set sm = s.Intersect(shTo)
        Set sm2 = s.Weld(sm, True, True)
        s.Delete
        sm.Delete
        shTo.Delete
        Set shTo = sm2
        shTo.OrderBackOf shIs
    Else
        shIs.GetPosition X, Y
        shIs.GetMatrix d11, d12, d21, d22, tx, ty
        shIs.GetSize W, H
        
        shTo.SetMatrix d11, d12, d21, d22, tx, ty
        shTo.SetSize W, H
        shTo.SetPosition X, Y
        shTo.OrderBackOf shIs
    End If
    
    If shIs.Transparency.Type = cdrUniformTransparency Then
        shTo.Transparency.ApplyUniformTransparency (shIs.Transparency.Uniform)
        shTo.Transparency.MergeMode = shIs.Transparency.MergeMode
    ElseIf shIs.Transparency.Type = cdrFountainTransparency Then
        shTo.Transparency.ApplyFountainTransparency shIs.Transparency.Start, _
        shIs.Transparency.End, shIs.Transparency.Fountain.Type, _
        shIs.Transparency.Fountain.Angle, shIs.Transparency.Fountain.Steps, _
        shIs.Transparency.Fountain.EdgePad, shIs.Transparency.Fountain.MidPoint, _
        shIs.Transparency.Fountain.CenterOffsetX, shIs.Transparency.Fountain.CenterOffsetY
        shTo.Transparency.MergeMode = shIs.Transparency.MergeMode
        If shIs.Transparency.Fountain.Colors.Count > 0 Then
            For i = 1 To shIs.Transparency.Fountain.Colors.Count
                shTo.Transparency.Fountain.Colors.Add shIs.Transparency.Fountain.Colors(i).Color, shIs.Transparency.Fountain.Colors(i).Position
            Next i
        End If
     ElseIf shIs.Transparency.Type = cdrPatternTransparency Then
        shTo.Transparency.ApplyPatternTransparency shIs.Transparency.Pattern.Type, _
        shIs.Transparency.Pattern.FilePath, shIs.Transparency.Pattern.Canvas.Index, _
        shIs.Transparency.Start, shIs.Transparency.End, shIs.Transparency.Pattern.TransformWithShape
        shTo.Transparency.MergeMode = shIs.Transparency.MergeMode
        shTo.Transparency.Pattern.BackColor = shIs.Transparency.Pattern.BackColor
        shTo.Transparency.Pattern.BackColor = shIs.Transparency.Pattern.BackColor
        shTo.Transparency.Pattern.FrontColor = shIs.Transparency.Pattern.FrontColor
        shTo.Transparency.Pattern.OriginX = shIs.Transparency.Pattern.OriginX
        shTo.Transparency.Pattern.OriginY = shIs.Transparency.Pattern.OriginY
        shTo.Transparency.Pattern.RotationAngle = shIs.Transparency.Pattern.RotationAngle
        shTo.Transparency.Pattern.SkewAngle = shIs.Transparency.Pattern.SkewAngle
        shTo.Transparency.Pattern.MirrorFill = shIs.Transparency.Pattern.MirrorFill
        shTo.Transparency.Pattern.TileHeight = shIs.Transparency.Pattern.TileHeight
        shTo.Transparency.Pattern.TileWidth = shIs.Transparency.Pattern.TileWidth
        shTo.Transparency.Pattern.TransformWithShape = shIs.Transparency.Pattern.TransformWithShape
        shTo.Transparency.Pattern.TileOffsetType = shIs.Transparency.Pattern.TileOffsetType
        shTo.Transparency.Pattern.TileOffset = shIs.Transparency.Pattern.TileOffset
        shTo.Transparency.Pattern = shIs.Transparency.Pattern
    ElseIf shIs.Transparency.Type = cdrTextureTransparency Then
        shTo.Transparency.ApplyTextureTransparency shIs.Transparency.Texture.TextureName, _
        shIs.Transparency.Texture.LibraryName, shIs.Transparency.Start, shIs.Transparency.End
        shTo.Transparency.MergeMode = shIs.Transparency.MergeMode
    End If
    
    If shIs.Effects.Count <> 0 Then
        If shIs.Effects.DropShadowEffect.DropShadow.Type = cdrDropShadowFlat Then
            If shIs.Effects.DropShadowEffect.DropShadow.FeatherType = cdrFeatherAverage Then
                Set efDrop = shTo.CreateDropShadow(shIs.Effects.DropShadowEffect.DropShadow.Type, _
                shIs.Effects.DropShadowEffect.DropShadow.Opacity, shIs.Effects.DropShadowEffect.DropShadow.Feather, _
                shIs.Effects.DropShadowEffect.DropShadow.OffsetX, shIs.Effects.DropShadowEffect.DropShadow.OffsetY, _
                shIs.Effects.DropShadowEffect.DropShadow.Color, shIs.Effects.DropShadowEffect.DropShadow.FeatherType, _
                 , , , , shIs.Effects.DropShadowEffect.DropShadow.MergeMode)
            Else
                Set efDrop = shTo.CreateDropShadow(shIs.Effects.DropShadowEffect.DropShadow.Type, _
                shIs.Effects.DropShadowEffect.DropShadow.Opacity, shIs.Effects.DropShadowEffect.DropShadow.Feather, _
                shIs.Effects.DropShadowEffect.DropShadow.OffsetX, shIs.Effects.DropShadowEffect.DropShadow.OffsetY, _
                shIs.Effects.DropShadowEffect.DropShadow.Color, shIs.Effects.DropShadowEffect.DropShadow.FeatherType, _
                shIs.Effects.DropShadowEffect.DropShadow.FeatherEdge, , , , _
                shIs.Effects.DropShadowEffect.DropShadow.MergeMode)
            End If
        Else
            If shIs.Effects.DropShadowEffect.DropShadow.FeatherType <> cdrFeatherAverage Then
                Set efDrop = shTo.CreateDropShadow(shIs.Effects.DropShadowEffect.DropShadow.Type, _
                shIs.Effects.DropShadowEffect.DropShadow.Opacity, shIs.Effects.DropShadowEffect.DropShadow.Feather, , , _
                shIs.Effects.DropShadowEffect.DropShadow.Color, shIs.Effects.DropShadowEffect.DropShadow.FeatherType, _
                shIs.Effects.DropShadowEffect.DropShadow.FeatherEdge, shIs.Effects.DropShadowEffect.DropShadow.PerspectiveAngle, _
                shIs.Effects.DropShadowEffect.DropShadow.PerspectiveStretch, shIs.Effects.DropShadowEffect.DropShadow.Fade, _
                shIs.Effects.DropShadowEffect.DropShadow.MergeMode)
            Else
                Set efDrop = shTo.CreateDropShadow(shIs.Effects.DropShadowEffect.DropShadow.Type, _
                shIs.Effects.DropShadowEffect.DropShadow.Opacity, shIs.Effects.DropShadowEffect.DropShadow.Feather, , , _
                shIs.Effects.DropShadowEffect.DropShadow.Color, shIs.Effects.DropShadowEffect.DropShadow.FeatherType, , _
                shIs.Effects.DropShadowEffect.DropShadow.PerspectiveAngle, _
                shIs.Effects.DropShadowEffect.DropShadow.PerspectiveStretch, shIs.Effects.DropShadowEffect.DropShadow.Fade, _
                shIs.Effects.DropShadowEffect.DropShadow.MergeMode)
            End If
        End If
    End If
    
End Sub

CrazyMaxTM · 02.02.2007

Ответ: Как запомнить наложенную на Shape прозрачность

dizzy сказал(а):
Товарищ, а Вы случаем не изобретаете как из корела в шопе фотки открывать? Если так, то макрос уже готов. Терпения запаститесь чуток, скора выложу в сеть. Если нет - могу выложить свое решение, правда очень интересно для чего еще оно могло понадобится...

Да да именно это и изобретаю, я помню как Вы писали что работаете над той же проблемой. Конечно приятно получить готовый макросс, но еще приятнее попробовать написать что то самому. Кстати большое спасибо за выложенный код, мое детище размерами поскромней. Обязательно попробую разобраться.

Удачи!

Поиск

Как запомнить наложенную на Shape прозрачность

CrazyMaxTM

Участник

wOxxOm

Участник

dizzy

Участник

lev

Модератор

dizzy

Участник

CrazyMaxTM

Участник