CorelDraw Animation Script

Hello I am new to the Forum it seems rather dead here but I'll post this anyway.

I joined the forum to hopefully get more info on the ApplyBitmapEffect but no one has really answered my post.  The post for that is community.coreldraw.com/sdk/f/40/t/52110 if you feel inclined to help me.

On to the subject of this post.  I did a search for animation in CorelDraw hoping to find a script that allows one to animate the vector graphic in CorelDraw X7 but didn't find anythig aside from a few mentions of using CorelPaint to make gifs. So i made a script that animates the vector over a series of pages.  Again i am new to the forum so i apoligize if they is a feature on this site to post code more effectively...i obviously have not found it. 

The below script (which by the way is provided as is, though i might check this post occasionally if you have questions) allows you to:

- Tween the  colors, positions, rotation, scales, nodes, and transparencies of the shapes on a range of pages

- Tween the  colors, positions, rotation, scales, nodes, and transparencies of a selection of shapes across a range of pages

- Play the animation on screen

- Halve the amount of Frames (pages) in the animation

- Double the amount of frames in the animation

- Copy a range of frames in reverse at the end of the animation

'=========================================

Dim Playing As Boolean
Sub UpdateShapes()
    
    If (ActiveSelectionRange.Count = 0) Then
        Call MsgBox("Error: Please select at least one shape first.")
        Exit Sub
    End If
    
    Dim first_page As Integer, last_page As Integer
    Dim current_page As Integer, current_shape As Integer
    
    first_page = Val(InputBox("Enter the page with the first frame.", "UpdateShapes", "" & ActivePage.index))
    If first_page = 0 Then Exit Sub
    If first_page = ActiveDocument.Pages.Count Then
        Call MsgBox("Error: There must be a page after the current page to tween with.")
        Exit Sub
    End If
    
    last_page = Val(InputBox("Enter the page with the last frame.", "UpdateShapes", ActiveDocument.Pages.Count))
    If last_page = 0 Then Exit Sub
   
    For Each s In ActiveSelectionRange
    'copy selected shape attributes to the shapes on the last page
    ActiveDocument.Pages(last_page).Shapes(s.ZOrder).CopyPropertiesFrom s, cdrCopyOutlineColor
    ActiveDocument.Pages(last_page).Shapes(s.ZOrder).CopyPropertiesFrom s, cdrCopyOutlinePen
    ActiveDocument.Pages(last_page).Shapes(s.ZOrder).CopyPropertiesFrom s, cdrCopyFill
    ActiveDocument.Pages(last_page).Shapes(s.ZOrder).CopyPropertiesFrom s, cdrCopyTextAttrs
    Next
    
    For i = first_page + 1 To last_page - 1
        For n = 1 To ActiveSelectionRange.Count
           current_page = i
           current_shape = ActiveSelectionRange.Shapes(n).ZOrder 'Count_Shapes(i) - (Count_Shapes(i) - selection.Shapes(n).ZOrder)
           If Not PagesMatch(first_page, last_page, current_page) Then Exit Sub
           Call Tween(first_page, last_page, current_page, current_shape)
        Next
    Next
    
End Sub

Sub ReversePages()

    first_page = Val(InputBox("Enter the page with the first frame.", "ReversePages", "" & ActivePage.index))
    If first_page = 0 Then Exit Sub
    If first_page = ActiveDocument.Pages.Count Then
        Call MsgBox("Error: There must be a page after the current page to tween with.")
        Exit Sub
    End If
    
    last_page = Val(InputBox("Enter the page with the last frame.", "ReversePages", ActiveDocument.Pages.Count))
    If last_page = 0 Then Exit Sub
    
    For i = first_page To last_page - 1
    Call DupPages(i, 1, last_page)
    Next
    
End Sub

Sub DoublePages()

    first_page = Val(InputBox("Enter the page with the first frame.", "DoublePages", "" & ActivePage.index))
    If first_page = 0 Then Exit Sub
    If first_page = ActiveDocument.Pages.Count Then
        Call MsgBox("Error: There must be a page after the current page to tween with.")
        Exit Sub
    End If
    
    last_page = Val(InputBox("Enter the page with the last frame.", "DoublePages", ActiveDocument.Pages.Count))
    If last_page = 0 Then Exit Sub
    
    For i = first_page To (last_page - 1 + 1) * 2 Step 2
    Call DupPages(i, 1, i)
    Next
    
End Sub

Sub HalvePages()

    first_page = Val(InputBox("Enter the page with the first frame.", "HalvePages", "" & ActivePage.index))
    If first_page = 0 Then Exit Sub
    If first_page = ActiveDocument.Pages.Count Then
        Call MsgBox("Error: There must be a page after the current page to tween with.")
        Exit Sub
    End If
    
    last_page = Val(InputBox("Enter the page with the last frame.", "HalvePages", ActiveDocument.Pages.Count))
    If last_page = 0 Then Exit Sub
    
    For i = last_page - 1 To first_page + 1 Step -2
    'delete the page
    ActiveDocument.Pages(i).Delete
    Next
    
End Sub

Sub DuplicatePageX()

    Dim sr As ShapeRange
    Dim pNext As Page
    Dim sDuplicate As Shape
    
    Set sr = ActivePage.Shapes.All
    Set pNext = ActiveDocument.InsertPages(1, False, ActivePage.index)
        
    Optimization = True
    
        For Each s In sr.ReverseRange
            Set sDuplicate = s.Duplicate
            sDuplicate.MoveToLayer pNext.Layers(s.Layer.Name)
        Next s
    Optimization = False
    ActiveWindow.Refresh
End Sub

Sub Play()
    
    If Playing = False Then Playing = True: GoTo Playit
    If Playing = True Then Playing = False: GoTo Stopit
    
Playit:
    Dim VPage As Integer
    Dim Time As Single, Count As Integer
    
    Count = 1
    Time = Timer
    VPage = 1
    
    While (Playing)
        ActiveDocument.Pages(VPage).Activate
        DoEvents
        
        If (Timer > Time + 1 / 30) Then
        VPage = VPage + 1
        Count = Count + 1
        Time = Timer
        End If
        
        If (VPage > ActiveDocument.Pages.Count) Then VPage = 1
    Wend

Stopit:
End Sub

Sub LineColorMatch()
'make the line color a darker tint of the fill color

Dim selection1 As ShapeRange
Dim colorR As Integer
Dim colorG As Integer
Dim colorB As Integer

Set selection1 = ActiveSelectionRange

Optimization = True

For Each CurrentShape In selection1
    
    '====================uniform=======================
    If (CurrentShape.Fill.Type = cdrUniformFill) And (CurrentShape.IsSimpleShape) _
    And (CurrentShape.Outline.Type = cdrOutline) Then
    'colorRgb = CurrentShape.Fill.UniformColor.RGBValue
    colorR = CurrentShape.Fill.UniformColor.RGBRed
    colorG = CurrentShape.Fill.UniformColor.RGBGreen
    colorB = CurrentShape.Fill.UniformColor.RGBBlue
    
    'colorRgb = colorRgb - 2105376
    colorR = colorR - 32
    colorG = colorG - 32
    colorB = colorB - 32
    
    'If colorRgb < 0 Then colorRgb = 0
    If colorR < 0 Then colorR = 0
    If colorG < 0 Then colorG = 0
    If colorB < 0 Then colorB = 0
    
    'CurrentShape.Outline.Color.RGBValue = colorRgb
    CurrentShape.Outline.Color.RGBRed = colorR
    CurrentShape.Outline.Color.RGBGreen = colorG
    CurrentShape.Outline.Color.RGBBlue = colorB
    
    
    '=====================fountain======================
    ElseIf (CurrentShape.Fill.Type = cdrFountainFill) And (CurrentShape.IsSimpleShape) _
    And (CurrentShape.Outline.Type = cdrOutline) Then
    'colorRgb = CurrentShape.Fill.UniformColor.RGBValue
    colorR = CurrentShape.Fill.Fountain.StartColor.RGBRed
    colorG = CurrentShape.Fill.Fountain.StartColor.RGBGreen
    colorB = CurrentShape.Fill.Fountain.StartColor.RGBBlue
    
    'colorRgb = colorRgb - 2105376
    colorR = colorR - 32
    colorG = colorG - 32
    colorB = colorB - 32
    
    'If colorRgb < 0 Then colorRgb = 0
    If colorR < 0 Then colorR = 0
    If colorG < 0 Then colorG = 0
    If colorB < 0 Then colorB = 0
    
    'CurrentShape.Outline.Color.RGBValue = colorRgb
    CurrentShape.Outline.Color.RGBRed = colorR
    CurrentShape.Outline.Color.RGBGreen = colorG
    CurrentShape.Outline.Color.RGBBlue = colorB
      
    '=====================pattern======================
    ElseIf (CurrentShape.Fill.Type = cdrPatternFill) And (CurrentShape.IsSimpleShape) _
    And (CurrentShape.Outline.Type = cdrOutline) Then
    
    If (CurrentShape.Fill.Pattern.Type = cdrTwoColorPattern) Then
    'colorRgb = CurrentShape.Fill.UniformColor.RGBValue
    colorR = CurrentShape.Fill.Pattern.BackColor.RGBRed
    colorG = CurrentShape.Fill.Pattern.BackColor.RGBGreen
    colorB = CurrentShape.Fill.Pattern.BackColor.RGBBlue
    
    'colorRgb = colorRgb - 2105376
    colorR = colorR - 32
    colorG = colorG - 32
    colorB = colorB - 32
    
    'If colorRgb < 0 Then colorRgb = 0
    If colorR < 0 Then colorR = 0
    If colorG < 0 Then colorG = 0
    If colorB < 0 Then colorB = 0
    
    'CurrentShape.Outline.Color.RGBValue = colorRgb
    CurrentShape.Outline.Color.RGBRed = colorR
    CurrentShape.Outline.Color.RGBGreen = colorG
    CurrentShape.Outline.Color.RGBBlue = colorB
    End If
    
    '===================All other Fills except grouped shapes=========================
    ElseIf (CurrentShape.IsSimpleShape) And (CurrentShape.Outline.Type = cdrOutline) Then
    'CurrentShape.Outline.Color.RGBValue = colorRgb
    CurrentShape.Outline.Color.RGBRed = 190
    CurrentShape.Outline.Color.RGBGreen = 190
    CurrentShape.Outline.Color.RGBBlue = 190
    End If
Next

    Optimization = False
    ActiveWindow.Refresh
End Sub

Sub PasteShapes()
    ' Pastes shapes over a range of pages
    
    If (ActiveSelectionRange.Count = 0) Then
        Call MsgBox("Error: Please select at least one shape first.")
        Exit Sub
    End If
        
    Dim selection As ShapeRange
    Dim first_page As Integer, last_page As Integer
    Dim depth_order As Integer, curr_shape As ShapeRange
    
    'get page range to paste on
    'first page will be the first copying begins on
    first_page = Val(InputBox("Start pasting on which page?", "PasteShapes", ActivePage.index + 1))
    If first_page = 0 Then Exit Sub
    
    'last page will be the last one the shape is pasted on
    last_page = Val(InputBox("End pasting on which page?", "PasteShapes", ActiveDocument.Pages.Count))
    If last_page = 0 Then Exit Sub
    
    Set selection = ActiveSelectionRange
    
    'get the zorder of the first shape
    depth_order = selection.Shapes(1).ZOrder
    selection.Copy
    
    Optimization = True
    
    For i = first_page To last_page
        Set curr_shape = ActiveDocument.Pages(i).Layers(2).PasteEx

        If (depth_order = ActiveDocument.Pages(i).Shapes.Count) Then
        curr_shape.OrderToBack
        Else
        curr_shape.OrderFrontOf ActiveDocument.Pages(i).Shapes(depth_order + 1)
        End If
    Next
    
    Optimization = False
    ActiveWindow.Refresh
End Sub

Sub TweenShapes()
    
    If (ActiveSelectionRange.Count = 0) Then
        Call MsgBox("Error: Please select at least one shape first.")
        Exit Sub
    End If
            
    Dim selection As ShapeRange
    Set selection = ActiveSelectionRange
    
    Dim first_page As Integer, last_page As Integer
    Dim current_page As Integer, current_shape As Integer
    
    'get imput only if this function is not called from UpdateShapes
 
     first_page = Val(InputBox("Enter the page with the first frame.", "TweenShapes", "" & ActivePage.index))
     If first_page = 0 Then Exit Sub
     If first_page = ActiveDocument.Pages.Count Then
         Call MsgBox("Error: There must be a page after the current page to tween with.")
         Exit Sub
     End If
     
     last_page = Val(InputBox("Enter the page with the last frame.", "TweenShapes", ActiveDocument.Pages.Count))
     If last_page = 0 Then Exit Sub
    
    For i = first_page + 1 To last_page - 1
        For n = 1 To selection.Count
           current_page = i
           current_shape = selection.Shapes(n).ZOrder 'Count_Shapes(i) - (Count_Shapes(i) - selection.Shapes(n).ZOrder)
           If Not PagesMatch(first_page, last_page, current_page) Then Exit Sub
           Call Tween(first_page, last_page, current_page, current_shape)
        Next
    Next

End Sub

Sub TweenPages()
    
    Dim first_page As Integer, last_page As Integer, Count As Integer
    Dim current_page As Integer, current_shape As Integer
     
    first_page = Val(InputBox("Enter the page with the first frame.", "TweenPages", "" & ActivePage.index))
    If first_page = 0 Then Exit Sub
    If first_page = ActiveDocument.Pages.Count Then
        Call MsgBox("Error: There must be a page after the current page to tween with.")
        Exit Sub
    End If
    
    Count = Val(InputBox("How many frames to add between each keyframe?", "TweenPages", 1))
    If Count = 0 Then Exit Sub
    
    last_page = Val(InputBox("Enter the page with the last frame.", "TweenPages", ActiveDocument.Pages.Count))
    If last_page = 0 Then Exit Sub
    
    For i = last_page - 1 To first_page Step -1
        Call DupPages(i, Count)
    Next
    Dim keyframes As Integer
    keyframes = last_page - first_page + 1
    
   'make last page = new last page after tweens were added
    'last_page = Count * (keyframes - 1) + keyframes + (first_page - 1)
    
    'initilize for the for loop
    first_page = first_page
    last_page = first_page + Count + 1
    
    For num = 1 To keyframes - 1
        If (num > 1) Then
        first_page = first_page + Count + 1 '3
        last_page = last_page + Count + 1 '5
        End If
        i = first_page + 1
        While (i < last_page)
             current_shape = 1 '0
            For n = 1 To ActiveDocument.Pages(first_page).Shapes.Count
                current_page = i
                
                If Not PagesMatch(first_page, last_page, current_page) Then Exit Sub
                Call Tween(first_page, last_page, current_page, current_shape)
                current_shape = current_shape + 1
            Next
            i = i + 1
        Wend
    Next
    
    'make last_page
    ActiveDocument.Pages(last_page).Activate
    
End Sub

Function DupPages(ByVal index As Integer, ByVal Count As Integer, Optional ByVal place_after As Integer = 0)
    'duplicates page as needed and tween all shapes on the page
    
    'Call PageDup(first_page, count - 2)
    
    Dim sr As ShapeRange
    Dim pNext As Page
    Dim sDuplicate As Shape
    
    For i = 1 To Count ' - 2
    Set sr = ActiveDocument.Pages(index).Shapes.All
    If (place_after = 0) Then Set pNext = ActiveDocument.InsertPages(1, False, index)
    If (place_after <> 0) Then Set pNext = ActiveDocument.InsertPages(1, False, place_after)
        
    Optimization = True
    
        For Each s In sr.ReverseRange
            Set sDuplicate = s.Duplicate
            sDuplicate.MoveToLayer pNext.Layers(s.Layer.Name)
        Next s
    Next
    
    Optimization = False
    ActiveWindow.Refresh
End Function

Function Lerp(first_step As Integer, last_step As Integer, current_step As Integer) As Double
    'Returns a fraction (IE 0.50) that represents the current slides placemtent between the start and end slides
    Lerp = (current_step - first_step) / (last_step - first_step)
End Function   '==>Lerp

Function Count_Shapes(ByVal num As Integer) As Integer
    'returns the current slide index
    Count_Shapes = ActiveDocument.Pages(num).Shapes.Count

End Function   '==>Count_Shapes

Function Tween(ByVal first_step As Integer, ByVal last_step As Integer, ByVal current_step As Integer, ByVal current_shape As Integer)

    'Dim first_step As Integer, last_step As Integer, current_step As Integer, current_shape As Integer
    
    Dim first_shape As Shape
    Dim last_shape As Shape
    Dim manip_shape As Shape
    
    ' interoplates the shape to a position based on the its postion in the start and end steps
    Set first_shape = ActiveDocument.Pages(first_step).Shapes(current_shape) 'Count_Shapes(first_step) - current_shape)
    Set last_shape = ActiveDocument.Pages(last_step).Shapes(current_shape) 'Count_Shapes(last_step) - current_shape)
    Set manip_shape = ActiveDocument.Pages(current_step).Shapes(current_shape) 'Count_Shapes(current_step) - current_shape)

    Dim startn As Double
    Dim endn As Double
    
    Optimization = True
    ActiveDocument.ReferencePoint = cdrCenter
    
    '===========================Tween Position================================
    startn = first_shape.PositionX
    endn = last_shape.PositionX
    manip_shape.PositionX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.PositionY
    endn = last_shape.PositionY
    manip_shape.PositionY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn

    '================================Tween Rotation================================
    startn = first_shape.RotationCenterX
    endn = last_shape.RotationCenterX
    manip_shape.RotationCenterX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
        
    startn = first_shape.RotationCenterY
    endn = last_shape.RotationCenterY
    manip_shape.RotationCenterY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.RotationAngle
    endn = last_shape.RotationAngle
    manip_shape.RotationAngle = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
        
    '================================Tween Scale================================
    If (first_shape.RotationAngle = last_shape.RotationAngle) Then
    startn = first_shape.SizeWidth
    endn = last_shape.SizeWidth
    manip_shape.SizeWidth = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.SizeHeight
    endn = last_shape.SizeHeight
    manip_shape.SizeHeight = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    Else
    Dim first_angle As Double, curr_angle As Double, last_angle As Double
    
    first_angle = first_shape.RotationAngle
    curr_angle = manip_shape.RotationAngle
    last_angle = last_shape.RotationAngle
    
    'set manip_shape's rotation and last_shape's rotation to the same as the first_shape
    manip_shape.RotationAngle = first_angle
    last_shape.RotationAngle = first_angle
    
    'scale manip_shape
    startn = first_shape.SizeWidth
    endn = last_shape.SizeWidth
    manip_shape.SizeWidth = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.SizeHeight
    endn = last_shape.SizeHeight
    manip_shape.SizeHeight = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    'return manip_shape and last_shape to their correct rotation
    manip_shape.RotationAngle = curr_angle
    last_shape.RotationAngle = last_angle
    End If
    
    
    If (first_shape.IsSimpleShape = False) And (last_shape.IsSimpleShape = False) Then GoTo SkipShape
    
    '=====================Tween Transparency========================
    '===uniform
    If first_shape.Transparency.Type = cdrNoTranparency Then
    first_shape.Transparency.ApplyUniformTransparency (0)
    End If
    If last_shape.Transparency.Type = cdrNoTranparency Then
    last_shape.Transparency.ApplyUniformTransparency (0)
    End If
    If manip_shape.Transparency.Type = cdrNoTranparency Then
    manip_shape.Transparency.ApplyUniformTransparency (0)
    End If
    
    If (first_shape.Transparency.Type = cdrUniformTransparency) And (last_shape.Transparency.Type = cdrUniformTransparency) Then
    startn = first_shape.Transparency.Uniform
    endn = last_shape.Transparency.Uniform
    manip_shape.Transparency.Uniform = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    End If
    
    '===fountain
    If (first_shape.Transparency.Type = cdrFountainTransparency) And (last_shape.Transparency.Type = cdrFountainTransparency) Then
    
    If (first_shape.Transparency.Fountain.Colors.Count = last_shape.Transparency.Fountain.Colors.Count) Then
        For i = 0 To first_shape.Transparency.Fountain.Colors.Count - 1
            startn = first_shape.Transparency.Fountain.Colors.GrayLevel(i)
            endn = last_shape.Transparency.Fountain.Colors.GrayLevel(i)
            manip_shape.Transparency.Fountain.Colors.GrayLevel(i) = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
        Next
    End If
        
    startn = first_shape.Transparency.Fountain.StartX
    endn = last_shape.Transparency.Fountain.StartX
    manip_shape.Transparency.Fountain.StartX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Fountain.StartY
    endn = last_shape.Transparency.Fountain.StartY
    manip_shape.Transparency.Fountain.StartY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Fountain.EndX
    endn = last_shape.Transparency.Fountain.EndX
    manip_shape.Transparency.Fountain.EndX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Fountain.EndY
    endn = last_shape.Transparency.Fountain.EndY
    manip_shape.Transparency.Fountain.EndY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Fountain.ScaleX
    endn = last_shape.Transparency.Fountain.ScaleX
    manip_shape.Transparency.Fountain.ScaleX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Fountain.ScaleY
    endn = last_shape.Transparency.Fountain.ScaleY
    manip_shape.Transparency.Fountain.ScaleY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Fountain.Angle
    endn = last_shape.Transparency.Fountain.Angle
    manip_shape.Transparency.Fountain.SetAngle Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Fountain.Skew
    endn = last_shape.Transparency.Fountain.Skew
    manip_shape.Transparency.Fountain.Skew = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    End If
    
    '===pattern
    If (first_shape.Transparency.Type = cdrPatternTransparency) And (last_shape.Transparency.Type = cdrPatternTransparency) Then
    startn = first_shape.Transparency.Pattern.SkewAngle
    endn = last_shape.Transparency.Pattern.SkewAngle
    manip_shape.Transparency.Pattern.SkewAngle = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Pattern.RotationAngle
    endn = last_shape.Transparency.Pattern.RotationAngle
    manip_shape.Transparency.Pattern.RotationAngle = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Pattern.OriginX
    endn = last_shape.Transparency.Pattern.OriginX
    manip_shape.Transparency.Pattern.OriginX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Pattern.OriginY
    endn = last_shape.Transparency.Pattern.OriginY
    manip_shape.Transparency.Pattern.OriginY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Pattern.TileHeight
    endn = last_shape.Transparency.Pattern.TileHeight
    manip_shape.Transparency.Pattern.TileHeight = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Pattern.TileWidth
    endn = last_shape.Transparency.Pattern.TileWidth
    manip_shape.Transparency.Pattern.TileWidth = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    End If
    
    '===Texture
    If (first_shape.Transparency.Type = cdrTextureTransparency) And (last_shape.Transparency.Type = cdrTextureTransparency) Then
    startn = first_shape.Transparency.Texture.SkewAngle
    endn = last_shape.Transparency.Texture.SkewAngle
    manip_shape.Transparency.Texture.SkewAngle = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Texture.RotationAngle
    endn = last_shape.Transparency.Texture.RotationAngle
    manip_shape.Transparency.Texture.RotationAngle = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Texture.OriginX
    endn = last_shape.Transparency.Texture.OriginX
    manip_shape.Transparency.Texture.OriginX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Texture.OriginY
    endn = last_shape.Transparency.Texture.OriginY
    manip_shape.Transparency.Texture.OriginY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Texture.TileHeight
    endn = last_shape.Transparency.Pattern.TileHeight
    manip_shape.Transparency.Pattern.TileHeight = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Transparency.Texture.TileWidth
    endn = last_shape.Transparency.Pattern.TileWidth
    manip_shape.Transparency.Pattern.TileWidth = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    End If
    
    '========================Tween Nodes==========================
    If manip_shape.Type = cdrCurveShape Then
    
    If (first_shape.RotationAngle = last_shape.RotationAngle) Then
        'make sure first and last shapes have same number of nodes
        If first_shape.Curve.Nodes.Count = last_shape.Curve.Nodes.Count Then
            For n = 1 To first_shape.Curve.Nodes.Count
                startn = first_shape.Curve.Nodes(n).PositionX
                endn = last_shape.Curve.Nodes(n).PositionX
                manip_shape.Curve.Nodes(n).PositionX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
                
                startn = first_shape.Curve.Nodes(n).PositionY
                endn = last_shape.Curve.Nodes(n).PositionY
                manip_shape.Curve.Nodes(n).PositionY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
                'n.SetPosition x, y
            Next
        End If
        
    Else
    'Dim first_angle As Double, curr_angle As Double, last_angle As Double
    
    first_angle = first_shape.RotationAngle
    curr_angle = manip_shape.RotationAngle
    last_angle = last_shape.RotationAngle
    
    'set manip_shape's rotation and last_shape's rotation to the same as the first_shape
    manip_shape.RotationAngle = first_angle
    last_shape.RotationAngle = first_angle
    
        If first_shape.Curve.Nodes.Count = last_shape.Curve.Nodes.Count Then
            For n = 1 To first_shape.Curve.Nodes.Count
                startn = first_shape.Curve.Nodes(n).PositionX
                endn = last_shape.Curve.Nodes(n).PositionX
                manip_shape.Curve.Nodes(n).PositionX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
                
                startn = first_shape.Curve.Nodes(n).PositionY
                endn = last_shape.Curve.Nodes(n).PositionY
                manip_shape.Curve.Nodes(n).PositionY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
                'n.SetPosition x, y
            Next
        End If
    
    'return manip_shape and last_shape to their correct rotation
    manip_shape.RotationAngle = curr_angle
    last_shape.RotationAngle = last_angle
    End If
    
    End If
    
    '=========================Tween Fills===========================
    '===fills
    'NOTE: make sure colors are RGB
    'NOTE: make sure we dont tween if first and last shape have the same colors
    
    '===uniform
    If (first_shape.Fill.Type = cdrUniformFill) And (last_shape.Fill.Type = cdrUniformFill) Then
    startn = first_shape.Fill.UniformColor.RGBRed
    endn = last_shape.Fill.UniformColor.RGBRed
    manip_shape.Fill.UniformColor.RGBRed = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.UniformColor.RGBGreen
    endn = last_shape.Fill.UniformColor.RGBGreen
    manip_shape.Fill.UniformColor.RGBGreen = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.UniformColor.RGBBlue
    endn = last_shape.Fill.UniformColor.RGBBlue
    manip_shape.Fill.UniformColor.RGBBlue = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    End If
    
    '===fountain
    If (first_shape.Fill.Type = cdrFountainFill) And (last_shape.Fill.Type = cdrFountainFill) Then
    
    If (first_shape.Fill.Fountain.Colors.Count = last_shape.Fill.Fountain.Colors.Count) Then
        For i = 0 To first_shape.Fill.Fountain.Colors.Count - 1
            startn = first_shape.Fill.Fountain.Colors(i).Color.RGBRed
            endn = last_shape.Fill.Fountain.Colors(i).Color.RGBRed
            manip_shape.Fill.Fountain.Colors(i).Color.RGBRed = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
            
            startn = first_shape.Fill.Fountain.Colors(i).Color.RGBGreen
            endn = last_shape.Fill.Fountain.Colors(i).Color.RGBGreen
            manip_shape.Fill.Fountain.Colors(i).Color.RGBGreen = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
            
            startn = first_shape.Fill.Fountain.Colors(i).Color.RGBBlue
            endn = last_shape.Fill.Fountain.Colors(i).Color.RGBBlue
            manip_shape.Fill.Fountain.Colors(i).Color.RGBBlue = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
            
            startn = first_shape.Fill.Fountain.Colors(i).Opacity
            endn = last_shape.Fill.Fountain.Colors(i).Opacity
            manip_shape.Fill.Fountain.Colors(i).Opacity = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
        
        Next
    End If
        
    startn = first_shape.Fill.Fountain.StartX
    endn = last_shape.Fill.Fountain.StartX
    manip_shape.Fill.Fountain.StartX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Fountain.StartY
    endn = last_shape.Fill.Fountain.StartY
    manip_shape.Fill.Fountain.StartY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Fountain.EndX
    endn = last_shape.Fill.Fountain.EndX
    manip_shape.Fill.Fountain.EndX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Fountain.EndY
    endn = last_shape.Fill.Fountain.EndY
    manip_shape.Fill.Fountain.EndY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Fountain.ScaleX
    endn = last_shape.Fill.Fountain.ScaleX
    manip_shape.Fill.Fountain.ScaleX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Fountain.ScaleY
    endn = last_shape.Fill.Fountain.ScaleY
    manip_shape.Fill.Fountain.ScaleY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Fountain.Angle
    endn = last_shape.Fill.Fountain.Angle
    manip_shape.Fill.Fountain.SetAngle Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Fountain.Skew
    endn = last_shape.Fill.Fountain.Skew
    manip_shape.Fill.Fountain.Skew = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    End If
    
    '===pattern
    If (first_shape.Fill.Type = cdrPatternFill) And (last_shape.Fill.Type = cdrPatternFill) Then
    startn = first_shape.Fill.Pattern.SkewAngle
    endn = last_shape.Fill.Pattern.SkewAngle
    manip_shape.Fill.Pattern.SkewAngle = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Pattern.RotationAngle
    endn = last_shape.Fill.Pattern.RotationAngle
    manip_shape.Fill.Pattern.RotationAngle = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Pattern.OriginX
    endn = last_shape.Fill.Pattern.OriginX
    manip_shape.Fill.Pattern.OriginX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Pattern.OriginY
    endn = last_shape.Fill.Pattern.OriginY
    manip_shape.Fill.Pattern.OriginY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Pattern.TileHeight
    endn = last_shape.Fill.Pattern.TileHeight
    manip_shape.Fill.Pattern.TileHeight = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Pattern.TileWidth
    endn = last_shape.Fill.Pattern.TileWidth
    manip_shape.Fill.Pattern.TileWidth = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    End If
    
    '===Texture
    If (first_shape.Fill.Type = cdrTextureFill) And (last_shape.Fill.Type = cdrTextureFill) Then
    startn = first_shape.Fill.Texture.SkewAngle
    endn = last_shape.Fill.Texture.SkewAngle
    manip_shape.Fill.Texture.SkewAngle = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Texture.RotationAngle
    endn = last_shape.Fill.Texture.RotationAngle
    manip_shape.Fill.Texture.RotationAngle = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Texture.OriginX
    endn = last_shape.Fill.Texture.OriginX
    manip_shape.Fill.Texture.OriginX = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Texture.OriginY
    endn = last_shape.Fill.Texture.OriginY
    manip_shape.Fill.Texture.OriginY = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Texture.TileHeight
    endn = last_shape.Fill.Texture.TileHeight
    manip_shape.Fill.TileHeight = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Fill.Texture.TileWidth
    endn = last_shape.Fill.Texture.TileWidth
    manip_shape.Fill.Texture.TileWidth = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    End If
    
    '=========================Tween Outline===========================
    'uniform
    If (first_shape.Outline.Type = cdrOutline) And (last_shape.Outline.Type = cdrOutline) Then
    startn = first_shape.Outline.Color.RGBRed
    endn = last_shape.Outline.Color.RGBRed
    manip_shape.Outline.Color.RGBRed = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Outline.Color.RGBGreen
    endn = last_shape.Outline.Color.RGBGreen
    manip_shape.Outline.Color.RGBGreen = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Outline.Color.RGBBlue
    endn = last_shape.Outline.Color.RGBBlue
    manip_shape.Outline.Color.RGBBlue = Lerp(first_step, last_step, current_step) * (endn - startn) + startn

    startn = first_shape.Outline.Width
    endn = last_shape.Outline.Width
    manip_shape.Outline.Width = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    
    startn = first_shape.Outline.DashDotLength
    endn = last_shape.Outline.DashDotLength
    manip_shape.Outline.DashDotLength = Lerp(first_step, last_step, current_step) * (endn - startn) + startn
    End If
    
SkipShape:

    Optimization = False
    ActiveWindow.Refresh

End Function

Function PagesMatch(ByVal first_step As Integer, ByVal last_step As Integer, current_step As Integer) As Boolean

    If (Count_Shapes(first_step) <> Count_Shapes(last_step)) _
    Or (Count_Shapes(first_step) <> Count_Shapes(current_step)) _
    Or (Count_Shapes(last_step) <> Count_Shapes(current_step)) Then
    Call MsgBox("Error! Pages: " & first_step & ", " & current_step & ",and " & last_step & _
                " do not have the same number of shapes.")
    PagesMatch = False
    Else
    PagesMatch = True
    End If
    
    'put this before a Tween call
    'If Not PagesMatch(first_page, last_page, current_page) Then Exit Sub
    
End Function
'=========================================

Parents
No Data
Reply
  • Hi all!

    Can anyone help me with short instructions how to set up this "animation macro" to be ready for use?

    A long time i'm searching for a macro that will Export "multiple Pages" from Corel Draw into one big Animated GIF [Page 1=Frame 1, Page 2=Frame 2, etc.], and this is the first code i found on the forums for this purpose. unfortunately i'm not familiar with the macro language, so i don't know exactly how to set it up...

    the frames in CorelDRAW... 

    how the result should be...

    Can anyone help me with short instructions?

    Thanks in advance!

Children
No Data