在PowerPoint2003中，当你插入一个Shape（图形）时，PowerPoint会傻乎乎地给Shape命名为诸如：矩形1，矩形2……，看着这一大堆一模一样的孪生兄弟，我们都搞不清楚谁是谁了，即使是微软自己也一定为搞不清楚而苦恼，因此在PowerPoint2007中才提供了一个叫做“选择窗格”的东西，不过这东西还是有点问题：它不能用拖动的方式来调整对象的叠放顺序。

下面我们就分系列来写作一个能在PowerPoint2003中重命名对象、显示/隐藏对象、快速调整对象叠放顺序的插件，希望朋友们能通过这样一个实例的操作快速地入门PPT插件的开发。

一、给所选对象重命名

（1）建立一个PPT文档

（2）按Alt+F11打开VBA编程环境。

（3）选择“插入”->“类模块”，并把这个类模块命名为“clsApp”

（4）在类模块中输入下列代码：

Public WithEvents App As Application '声明一个响应事件的PPT程序对象App
Public ActiveObj As Object

Private Sub App_SlideSelectionChanged(ByVal SldRange As SlideRange)
If ActivePresentation.ReadOnly Then Exit Sub '如果演示文稿只读则退出。
    If SldRange.Count = 1 Then '如果没有选择多张幻灯片，这样就可以对所选择的幻灯片进行重命名
        cbMenu.Controls("Edit").Text = SldRange.Name
        Set ActiveObj = SldRange
    Else
        cbMenu.Controls("Edit").Text = ""
        Set ActiveObj = Nothing
    End If
End Sub

Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
If ActivePresentation.ReadOnly Then Exit Sub
    Select Case Sel.Type '判断选区类型
        Case ppSelectionText '选择的是文本框
            cbMenu.Controls("Edit").Text = Sel.ShapeRange.Name
            Set ActiveObj = Sel.ShapeRange
        Case ppSelectionShapes '选择的是Shape
            If Sel.ShapeRange.Count = 1 Then '只能选一个Shape，否则出错
                cbMenu.Controls("Edit").Text = Sel.ShapeRange.Name
                Set ActiveObj = Sel.ShapeRange
            Else
                cbMenu.Controls("Edit").Text = ""
                Set ActiveObj = Nothing
            End If
        Case ppSelectionNone '什么也没有选
            cbMenu.Controls("Edit").Text = ""
            Set ActiveObj = Nothing
    End Select
End Sub

（5）插入一个模块并命名为mdApp，输入下列代码：

Public clsApp As New clsApp '声明刚才插入的类模块的实例clsapp
Public cbMenu As CommandBar '声明一个命令栏对象

'下面是两个自动运行的宏，这个宏只在PPA中才有效。
Sub Auto_Open()
    Set clsApp.App = Application '把当前的程序实例与类中的App对象进行关联
    CreateMenu '建立工具栏
End Sub

Sub Auto_Close()
On Error Resume Next
    CommandBars("Name Tools").Delete '退出程序时删除建立的命令栏
    End
End Sub

'###############################
'建立命令栏的子过程
'###############################
Sub CreateMenu()
    On Error Resume Next
    CommandBars("Name Tools").Delete
    Err.Clear
    Dim cbCtl As CommandBarControl '声明一个命令栏上的控件

    Set cbMenu = CommandBars.Add("Name Tools") '增加一个叫做"Name Tools"的命令栏
        With cbMenu.Controls.Add(msoControlEdit) '在这个命令栏上增加一个Edit控件
            .Caption = "Edit"
            .OnAction = "Change" '响应动作：Change
        End With
    cbMenu.Visible = True '让命令栏可见
End Sub

'#########################################
'给所选择的对象重命名的子过程
'#########################################
Sub Change()
    On Error Resume Next
    With cbMenu.Controls("Edit")
        If .Text = "" Then: .Text = clsApp.ActiveObj.Name '把所选择对象的名字显示在文框中
        clsApp.ActiveObj.Name = .Text '输入名字并按下回车给对象重命名
        Select Case Err '捕捉错误信息并进行处理
            Case 70
                ActiveWindow.Selection.SlideRange.Shapes(.Text).Select
            Case -2147188160
                ActivePresentation.Slides(.Text).Select
        End Select
    End With
End Sub

（6）在PowerPoint中选择“文件”->“另存为”，“保存类型”选择“PowerPoint 加载宏（*.ppa）”，一个给对象重命名的插件就做好了。

（7）测试效果，在PowerPoint中，选择“工具”->“加载宏”，然后浏览至你刚才保存的文件就可以加载我们刚才编写的插件了。

示例插件下载：http://www.brsbox.com/filebox/down/fc/b68fb4ee97cce3b08c5255d58b872410

下一讲，我将改写上面的代码，把它放入到一个窗体中，从而实现命名的批量功能和对象的显示/隐藏功能。

Sub SetSlideSize()
      ' 这个常数用于把单位设为英寸
      Const PTS As Byte = 72
      With ActivePresentation.PageSetup
         .SlideWidth = 8 * PTS '8英寸
         .SlideHeight = 6 * PTS
      End With
   End Sub

Sub GetSlideSize()
      Dim Width As Single
      Dim Height As Single
      With ActivePresentation.PageSetup
         Width = .SlideWidth
         Height = .SlideHeight
      End With
      MsgBox "幻灯片的宽度是： " & (Width / 72) & "英寸，高度是： " _
         & (Height / 72) & "英寸。"
   End Sub

构建一个事件句柄

你能够在VB.net中使用下面方法之一构建一个事件句柄。采用哪种方法取决于你打算怎样用一个事件去关联事件句柄。
方法1
典型的做法是使用WithEvents关键字建立一个事件句柄。
方法2
VB.net提供了另一种方式处理事件，你可以使用AddHandler和RemoveHandler语句动态地开始和停止指定事件的句柄。

注意： 如果你使用WithEvents关键字构建了事件句柄，那么你可能会接收到一个System.Reflection.TargetInvocationException异常，因此

，最好采用AddHandler来构建事件句柄。

建立VB.net自动客户端处理PPT事件

下面将分步告诉你怎样使用AddHandler语句处理PPT事件：

按下列步骤建立一个VB工程：
(1)开始Microsoft Visual Studio .NET .
(2)在文件菜单中，单击新建然后单击工程。
(3)在工程类型列表中，单击VB工程，在模版列表中，单击Windows应用程序。
(4)把工程名命名为PowerPointEvents然后单击“确定”。

增加PPT对象库和Graph对象库的引用：
（1）在工程菜单中，单击增加引用。
（2）在COM选项中，单击Microsoft PowerPoint 11.0 Object Library 然后选择。.
（3）在COM选项中，单击Microsoft Graph 11.0 Object Library 然后选择。
（4）然后单击“确定”。
（5）双击窗体，打开代码窗口。
（6）在Form1.vb的顶部，增加下面的代码：
 Imports PowerPoint = Microsoft.Office.Interop.PowerPoint
 Imports Office = Microsoft.Office.Core
 Imports Graph = Microsoft.Office.Interop.Graph

（7）在视图菜单中，单击Designer（设计）.
（8）在视图菜单中，单击“工具栏”，然后增加一个按钮给Form1.
（9）双击Button1.，打开 Button1_Click事件。
（10）在Button1_Click的前面插入下面代码：
 Dim oApp As PowerPoint.Application
 Dim oPres As PowerPoint.Presentation

（11）把下列代码增加给Button1_Click事件。
        Const sTemplate = "C:\Program Files\Microsoft Office\Templates\Presentation Designs\Orbit.pot"
        ' 如果前面 模版无效，请改变上面的内容。
        Const sVideo = "C:\WINDOWS\system32\oobe\images\intro.wmv"

        Dim oPresentations As PowerPoint.Presentations
        Dim oSlides As PowerPoint.Slides
        Dim oSlide As PowerPoint.Slide
        Dim oShapes As PowerPoint.Shapes
        Dim oShape As PowerPoint.Shape
        Dim oMovie As PowerPoint.Shape
        Dim oAnimationSettings As PowerPoint.AnimationSettings
        Dim oPlaySettings As PowerPoint.PlaySettings
        Dim oTextFrame As PowerPoint.TextFrame
        Dim oTextRange As PowerPoint.TextRange
        Dim oFont As PowerPoint.Font
        Dim oOLEFormat As PowerPoint.OLEFormat
        Dim oShadow As PowerPoint.ShadowFormat
        Dim oForeColor As PowerPoint.ColorFormat
        Dim oRange As PowerPoint.SlideRange
        Dim oSlideShowTransition As PowerPoint.SlideShowTransition

        '启动PowerPoint然后把其窗口最小化。
        oApp = New PowerPoint.Application

        '增加事件句柄
        AddHandler oApp.SlideShowBegin, AddressOf oApp_SlideShowBegin
        AddHandler oApp.SlideShowNextSlide, AddressOf oApp_SlideShowNextSlide
        AddHandler oApp.PresentationClose, AddressOf oApp_PresentationClose

        oApp.Visible = True
        oApp.WindowState = PowerPoint.PpWindowState.ppWindowMinimized

        '用指定的模版建立一个新演示文稿。
        oPresentations = oApp.Presentations
        oPres = oPresentations.Open(sTemplate, , , True)

        '建立幻灯片1
        '增加文本到该幻灯片，设置字体然后插入一个影片。
        oSlides = oPres.Slides
        oSlide = oSlides.Add(1, PowerPoint.PpSlideLayout.ppLayoutTitleOnly)
        oShapes = oSlide.Shapes
        oShape = oShapes.Item(1)
        oTextFrame = oShape.TextFrame
        oTextRange = oTextFrame.TextRange
        oTextRange.Text = "一个示例演示文稿"
        oFont = oTextRange.Font
        oFont.Name = "黑体"
        oFont.Size = 48

        oMovie = oShapes.AddMediaObject(sVideo, 150, 150, 500, 350)
        oAnimationSettings = oMovie.AnimationSettings
        oPlaySettings = oAnimationSettings.PlaySettings
        oPlaySettings.PlayOnEntry = True
        oPlaySettings.HideWhileNotPlaying = True

        '释放对象
        NAR(oPlaySettings)
        NAR(oAnimationSettings)
        NAR(oMovie)
        NAR(oFont)
        NAR(oTextRange)
        NAR(oTextFrame)
        NAR(oShape)
        NAR(oShapes)
        NAR(oSlide)
        NAR(oSlides)

        '建立幻灯片2.
        '增加文本到该幻灯片标题并格式化文本，增加一个 chart并把其类型设置为三维柱状样式
        oSlides = oPres.Slides
        oSlide = oSlides.Add(2, PowerPoint.PpSlideLayout.ppLayoutTitleOnly)
        oShapes = oSlide.Shapes
        oShape = oShapes.Item(1)
        oTextFrame = oShape.TextFrame
        oTextRange = oTextFrame.TextRange
        oTextRange.Text = "My chart"
        oFont = oTextRange.Font
        oFont.Name = "Comic Sans MS"
        oFont.Size = 48

        Dim oChart As Graph.Chart
        oShape = oShapes.AddOLEObject(150, 150, 480, 320, "MSGraph.Chart.8")
        oOLEFormat = oShape.OLEFormat
        oChart = oOLEFormat.Object
        oChart.ChartType = Graph.XlChartType.xl3DColumnClustered

        '释放对象
        NAR(oChart)
        NAR(oOLEFormat)
        NAR(oFont)
        NAR(oTextRange)
        NAR(oTextFrame)
        NAR(oShape)
        NAR(oShapes)
        NAR(oSlide)
        NAR(oSlides)

        '建立幻灯片3
        '增加一个艺术字并应用阴影效果
        oSlides = oPres.Slides
        oSlide = oSlides.Add(3, PowerPoint.PpSlideLayout.ppLayoutBlank)
        oSlide.FollowMasterBackground = False
        oShapes = oSlide.Shapes
        oShape = oShapes.AddTextEffect(Office.MsoPresetTextEffect.msoTextEffect27, _
            "The End", "Impact", 96, False, False, 230, 200)

        oShadow = oShape.Shadow
        oForeColor = oShadow.ForeColor
        oForeColor.SchemeColor = PowerPoint.PpColorSchemeIndex.ppForeground
        oShadow.Visible = True
        oShadow.OffsetX = 3
        oShadow.OffsetY = 3

        '释放对象.
        NAR(oShadow)
        NAR(oForeColor)
        NAR(oShape)
        NAR(oShapes)
        NAR(oSlide)
        NAR(oSlides)

        '修改演示文稿中所有幻灯片的放映切换设置。
        Dim SlideIdx(3) As Integer
        SlideIdx(0) = 1
        SlideIdx(1) = 2
        SlideIdx(2) = 3

        oSlides = oPres.Slides
        oRange = oSlides.Range(SlideIdx)
        oSlideShowTransition = oRange.SlideShowTransition
        oSlideShowTransition.AdvanceOnTime = False
        oSlideShowTransition.EntryEffect = PowerPoint.PpEntryEffect.ppEffectBoxOut

        '放映幻灯片
        RunSlideShow()

        '释放对象
        NAR(oSlideShowTransition)
        NAR(oRange)
        NAR(oSlides)

        '不保存改变关闭演示文稿
        oPres.Saved = True
        oPres.Close()

        '释放对象
        NAR(oPres)
        NAR(oPresentations)

        '移去所有事件句柄
        RemoveHandler oApp.SlideShowBegin, AddressOf oApp_SlideShowBegin
        RemoveHandler oApp.SlideShowNextSlide, AddressOf oApp_SlideShowNextSlide
        RemoveHandler oApp.PresentationClose, AddressOf oApp_PresentationClose

        '退出PPT
        oApp.Quit()
        NAR(oApp)

        GC.Collect()

12、下面这两过程用于Button1_Click事件中，用来启动幻灯片放映
 Private Sub RunSlideShow()
            Dim oSettings As PowerPoint.SlideShowSettings
     Dim oSlideShowWindows As PowerPoint.SlideShowWindows

     oSettings = oPres.SlideShowSettings
     oSettings.StartingSlide = 1
            oSettings.EndingSlide = 3

            oSettings.Run()

            oSlideShowWindows = oApp.SlideShowWindows

            On Error Resume Next
            Do While oSlideShowWindows.Count >= 1
         System.Windows.Forms.Application.DoEvents()
            Loop

     NAR(oSlideShowWindows)
            NAR(oSettings)
 End Sub

     'NAR用于释放对象
    Private Sub NAR(ByVal o As Object)
            Try
         System.Runtime.InteropServices.Marshal.ReleaseComObject(o)
            Catch
            Finally
                o = Nothing
            End Try
     End Sub

13、增加事件句柄:

     Private Sub oApp_SlideShowBegin(ByVal Wn As Microsoft.Office.Interop.PowerPoint.SlideShowWindow)
            '改变放映窗口的位置和大小
            Dim oView As PowerPoint.SlideShowView

            With Wn
                .Height = 325
                .Width = 400
                .Left = 100
                .Activate()
            End With
            oView = Wn.View
            oView.Next()

            NAR(oView)
            NAR(Wn)
     End Sub

     Private Sub oApp_SlideShowNextSlide(ByVal Wn As Microsoft.Office.Interop.PowerPoint.SlideShowWindow)
            '改变放映窗口指针的颜色和类型
            Dim Showpos As Integer
            Dim oView As PowerPoint.SlideShowView
            Dim oColorFormat As PowerPoint.ColorFormat

            oView = Wn.View
            Showpos = oView.CurrentShowPosition + 1

            If Showpos = 3 Then
                oColorFormat = oView.PointerColor
                oColorFormat.RGB = RGB(255, 0, 0)
                oView.PointerType = PowerPoint.PpSlideShowPointerType.ppSlideShowPointerPen
            Else
                oColorFormat = oView.PointerColor
                oColorFormat.RGB = RGB(0, 0, 0)
                oView.PointerType = PowerPoint.PpSlideShowPointerType.ppSlideShowPointerArrow
            End If

            NAR(oColorFormat)
            NAR(oView)
            NAR(Wn)
     End Sub

     Private Sub oApp_PresentationClose(ByVal Pres As Microsoft.Office.Interop.PowerPoint.Presentation)
            '关闭演示文稿前，把它保存为网页格式。
            Pres.SaveAs("C:\TestEvents.htm", PowerPoint.PpSaveAsFileType.ppSaveAsHTML)
            NAR(Pres)
     End Sub

声明：

（1）未经许可，请不要向别人发布该测试版安装程序或提供下载链接，本软件受中华人民共和国《著作权法》的保护。
（2）请不要在工作文档中测试，这样可以避免由于某些缺陷而导致数据丢失。本人不承担由于不正确的测试方法而造成的损失。

（1）采用Flash工具面板界面，非常直观方便快速。
（2）可视化的填充设置，支持实时渐变编辑。
（3）快速地对对象进行“对齐”、“布局”，“大小调整”和“批量更名”。
（4）利用“变形”，可以对对象围绕指定点进行旋转并复制，从而制作出非常复杂而炫丽的图形。
（5）提供了超过几十种的对象“滤镜”效果。
部分功能还没有写完，将不包括在Beta版中。

在office 2007发行版本中，对图表的修改并没有涉及整个的office，如在Word和PowerPoint中就没有提供。但是在office 2007 SP2和office 2010中微软在Word和PowerPoint中提供了统一的图表对象模型。图表由Office共享的绘图层绘制，如果你熟悉在Excel 2007中应用图表对象，你就能很容易地在Word或PowerPoint建立相似的解决方案。

很多时候，公司需要在文档或演示文稿中建立客户指定数据的图表，在一般情况下，这些图表有一个标准格式，大小和位置。这个图表对象可以作为解决方案的一部分自动地生成所需要的图表，从而既节省了时间，又避免了繁重的体力劳动。

下面提供一个例子，在PowerPoint中建立一个图表。

Sub CreateChart()
    Dim oChart As Chart
    Dim oChartData As ChartData
    Dim oWB As Excel.Workbook
    Dim oWS As Excel.Worksheet
    Set oChart = ActivePresentation.Slides(1).Shapes.AddChart.Chart '建立chart
    Set oChartData = ActivePresentation.Slides(1).Shapes(1).Chart.ChartData
    Set oWB = oChartData.Workbook
    Set oWS = oWB.Worksheets(1)
    oWS.ListObjects("Table1").Resize gWorkSheet.Range("A1:B5") '增加数据
    oWS.Range("Table1[[#Headers],[Series 1]]").Value = "销售"
    oWS.Range("a2").Value = "自行车"
    oWS.Range("a3").Value = "配件"
    oWS.Range("a4").Value = "修理"
    oWS.Range("a5").Value = "服装"
    oWS.Range("b2").Value = "1000"
    oWS.Range("b3").Value = "2500"
    oWS.Range("b4").Value = "4000"
    oWS.Range("b5").Value = "3000"
    With oChart
        .ChartStyle = 4
        .ApplyLayout 4
        .ClearToMatchStyle
    End With
    oChart.HasTitle = True '增加标题
    With oChart.ChartTitle '格式化标题
        .Characters.Font.Size = 18
        .Text = "2007 Sales"
    End With
    With oChart.Axes(xlValue)
        .HasTitle = True
        .AxisTitle.Text = "$"
    End With
    oChart.ApplyDataLabels
    Set oWS = Nothing
    oWB.Application.Quit
    Set oWB = Nothing
    Set oChartData = Nothing
    Set oChart = Nothing
End Sub

由上面的代码，我们可以看到一个图表仍然通过一个Shape来加载。

在PowerPoint中，通过编程来操纵图表为我们在演示过程中设计图表的动态外观打开了一片门。

 视频下载:http://www.brsbox.com/filebox/down/fc/7b8662dea5c5e5ad65004bb63e787fc7

1、如何注册？

（1）下载并安装PowerPoint动画库扩展，下载地址在下面。

（2）打开PowerPoint，找到它的工具栏（PPT2003会自动出现，2007在“加载项”中），单击“注册”按钮，在打开的窗口中记下“产品特征码”。

（3）通过支付宝、网上银行、扑奔网上商城或银行汇款的方式付出40元人民币的注册费用。

（4）向Wuji.zhifeng@163.com发送邮件，邮件内容包括上面记下的“产品特征码”，注册什么产品，注册人常用邮箱或姓名、地址、其他可靠的联系方式。

（5）通过审核（最长不超过三天），我们会通过邮件的方式把授权注册码寄出。

（6）运用获取的授权注册码进行注册，成功后即可正常使用。

2、授权注册码是否可以用于其他电脑？

授权注册码具有全球唯一性，只能应用于符合特征码的电脑上，用于其他电脑将被视为非法。

3、授权注册码有没有时间限制？

没有，授权注册码终身有效。

4、是否可以免费升级？

当然可以，这是注册用户应该享受的权利。

5、如果我更换了电脑，是否可以为我更换授权注册码？

在PowerPoint动画库扩展推出时，我们曾提供了这样的服务，然而因为出现了某些令人不愉快的事情，所以我们现在只提供一个注册用户有一次更换授权注册码的机会，而这样的机会在PowerPoint动画库扩展3.0之后也会取消。当然，在3.0推出之前注册的用户，如果他没有用掉这个机会，我们会一直为他保留。

6、现有注册方式太单一，是否可以提供更方便的注册方式？

很多的朋友来信反映PowerPoint动画库扩展注册方式非常原始和不便，希望提供更好的注册方式。为此，我们开通过了“支付宝”帐户和“扑奔”网上商城。

“支付宝”帐户：wuji.zhifeng@163.com

“扑奔网上商城”：http://www.pooban.com/mall/index.php?app=goods&id=13

下载PowerPoint动画库扩展：http://www.brsbox.com/filebox/down/fc/3f138a06b325a857cff40a2637844569

（1）基础的数学能力
（2）基础的VBA语言能力
（3）基本的算法能力

当您有了上面的基础知识之后，您就可以开始下面神奇的代码之旅了。

代码段一：绘正叶图

Sub 绘正叶图()
Dim r, x, y, i As Double
Dim cx, cy
Const PI = 3.1415926
For i = 0 To 6.3 Step 0.1
    r = 4 * Cos(2 * i)
    x = r * Cos(i)
    y = r * Sin(i)
    If i = 0 Then
        cx = 320 + x * 50
        cy = 240 - y * 50
        'ActivePresentation.SlideShowWindow.View.DrawLine cx, cy, 320 + x * 50, 240 - y * 50
    Else
        ActivePresentation.SlideShowWindow.View.DrawLine cx, cy, 320 + x * 50, 240 - y * 50
    cx = 320 + x * 50
    cy = 240 - y * 50
    End If
Next i
End Sub

代码二：绘钻石

Sub 绘钻石()
Dim x(50), y(50), Xc, Yc, tt, n, r, i, j
    Xc = 320
    Yc = 240
    r = 200
    n = 21
    tt = 2 * 3.14159 / n
    For i = 0 To n - 1
        x(i) = Xc + r * Cos(i * tt)
        y(i) = Yc - r * Sin(i * tt)
    Next i
    For i = 0 To n - 2
        For j = i + 1 To n - 1
            ActivePresentation.SlideShowWindow.View.DrawLine x(i), y(i), x(j), y(j)
        Next j
    Next i
End Sub

代码三：绘星形

Sub 绘星形()
    a = 100
    b = 10
    x = a
    y = a
    For i = 0 To 10
        star x, y
        x = x + b
        y = y - b
    Next i
    x = a
    y = a
    For i = 0 To 10
        star x, y
        x = x - b
        y = y + b
    Next i
End Sub
Private Sub star(x, y)
    ActivePresentation.SlideShowWindow.View.DrawLine 320, 200 - y, 320 - x, 200
    ActivePresentation.SlideShowWindow.View.DrawLine 320 - x, 200, 320, 200 + y
    ActivePresentation.SlideShowWindow.View.DrawLine 320, 200 + y, 320 + x, 200
    ActivePresentation.SlideShowWindow.View.DrawLine 320 + x, 200, 320, 200 - y
End Sub

 代码四：绘树形图

Sub 绘树形图()
    a = 3.14 / 15#
    th = 3.14 / 12#
    '绘出树干
    ActivePresentation.SlideShowWindow.View.DrawLine 150, 400, 450, 400
    ActivePresentation.SlideShowWindow.View.DrawLine 285, 400, 300, 180
    ActivePresentation.SlideShowWindow.View.DrawLine 300, 180, 315, 400
    '用随机函数Rnd绘制树叶
    For i = 0 To 99
        Xc = 180 + Rnd * 200
        Yc = 100 + Rnd * 180
        For j = 0 To 12
            x = Xc + 20 * Cos(j * a + th)
            y = Yc - 20 * Sin(j * a + th)
            ActivePresentation.SlideShowWindow.View.DrawLine Xc, Yc, x, y
        Next j
    Next i
End Sub

代码五：绘漂亮像框

Sub 绘漂亮像框()
    Const PI = 3.1415926
    Dim px, py, x, y, r, l, nn, i, n As Integer
    Dim x1(121), x2(121), y1(121), y2(121), cx, cy As Double
    Dim a As Double
    'PictDraw.Cls
    r = 35
    n = -1
    nn = 35
    i = 1
    For a = 0 To 2 * PI Step PI / 60
          
        x1(i) = CInt((1.1 * (r / 5 * Sin(8 * a) + r * Sin(2 * a)) * Cos(a)))
        y1(i) = CInt((0.85 * (r / 5 * Sin(8 * a) + r * Sin(2 * a)) * Sin(a)))
        x2(i) = CInt(((r / 5 * Sin(6 * a) + r * Sin(2 * a)) * Cos(a)))
        y2(i) = CInt(((r / 5 * Sin(6 * a) + r * Sin(2 * a)) * Sin(a)))
        i = i + 1
    Next a
    For px = 120 To 540 Step 60
        For py = 50 To 350 Step 60
            n = n + 1
            If px = 120 Or px = 540 Or py = 50 Or py = 350 Then
                For i = 1 To 121
                    x = (x2(i) - x1(i)) / nn * n + x1(i)
                    y = (y2(i) - y1(i)) / nn * n + y1(i)
                    x = (x + px) / 2
                    y = (y + py) / 2
                    If i = 1 Then
                        cx = x
                        cy = y
                    Else
                        ActivePresentation.SlideShowWindow.View.DrawLine cx, cy, x, y
                cx = x: cy = y
                    End If
                Next i
            End If
        Next py
    Next px
End Sub

现在SourceTec公司推出了一款让SilverLight平民化的工具：Sothink Quicker For SilverLight 3.0，只要你用过Flash，你就能快速熟练地操纵这个工具，有了这个工具，SilverLight将脱去它高贵的外衣，走入寻常百姓家。

从此我们就可以像制作Flash那样来制作SilverLight动画了。

支持微软Silverlight V2.0.
一个Silverlight 动画制作领先工具
支持创建各种动画, 如补间动画, 引导线动画和逐帧动画.
为您创建的图像和形状提供了全套的绘图工具
提供强大形状编辑能力
支持导入SWF文件或单个的SWF元素,例如图像,声音等来创建Silverlight动画.
支持导入和编辑各种声音、图像和视频格式.
支持输出Microsoft Expression Blend Solution.
支持替换实例符号
支持使用C#或JavaScript独立编写脚本
支持加入事件句柄
支持多字节语言文本