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
'=========================================

  • 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!

  • Such a nice post great to read and according to me, it’s very useful for everyone who is in the design field. Especially the newbies should read this one to make their work more effective. But if you have any design issues so you have to contact any website design firm for your solutions