陀螺的故事。同样是旋转的游戏，不过这次转的是陀螺。公主要过生日了，因为公主特喜欢陀螺，所以官员们都争相给公主做陀螺。前面有两个官员，找的人做的陀螺都很厉害很出色。一个是全国有名的木匠雕刻的陀螺，转动起来就象是钉子钉在地上一样，转动得要多稳有多稳；一个是著名的画家制作的陀螺，图案很是精美绝伦，但转动起来就看不到了。公主对这俩陀螺都不感兴趣，轮到一休了，但一休说这个陀螺是大街上买来的普通的陀螺，人们都很泄气。但一转动起来，这个黑白配的陀螺却能转出彩虹的颜色，颜色会不断地变动，公主很是喜欢。
    原来一休在陀螺的白色顶面上画了颜色，一半是黑色，一半是四段三组合的同心圆的弧线，每两个相邻的同心圆的边缘距离都是相等的。一转动起来，就会出现彩虹的颜色，这是英国人在很早很早的时候发现的，但至今仍没有什么科学的道理可以解释，是个神奇的谜。
===================
《一休》里黑白的陀螺旋转会产生彩色的图案

http://s14/mw690/5f33a6e8te06fa87ed7dd&690

昨天想做这种陀螺玩，找了好久没找到可用的图案，最后只能找到《一休》鸡蛋和陀螺那一集，仔细看了一下动画片，自己用Word编了个宏画了几个线条不同的试试，在Word里转了一下看看好像还有点效果，
 
这些图案顺时针旋转时，外圈近似红色，内圈深色。发Word文档好像有点麻烦，我直接把画这个陀螺的函数发出来好了。画好了用打印机打印出来，剪下贴在硬纸板上，中间插上小棍子转转看看哦。
http://s1/mw690/5f33a6e8te06faace4d10&690

下面是画这个陀螺的函数，因为懒得添加设置线型的语句了，画好了自己选择那些弧线条设置不同的线型试试效果。

Sub 画陀螺1()
'
' Macro1 Macro
' 宏在 2009-6-5 由 晶晶 录制
'彩色陀螺
Dim ArcLeft As Single, ArcTop As Single, ArcWidth  As Single, ArcHeight As Single
''''''画圆
Dim CycleD As Single, StepR As Single, CycleL As Single, CycleT As Single
        CycleL = 150
        CycleT = 50
        CycleD = 212
    ActiveDocument.Shapes.AddShape(msoShapeOval, CycleL, CycleT, CycleD, CycleD).Select
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 0)
   '''''画半圆
    ActiveDocument.Shapes.AddShape(msoShapeBlockArc, CycleL, CycleT, CycleD, CycleD).Select
    Selection.ShapeRange.Adjustments.Item(1) = 180#  '调整圆弧角度
    Selection.ShapeRange.Adjustments.Item(2) = 0#   '调整圆心距离
   
    ArcLeft = CycleL + CycleD / 2
    StepR = CycleD / 26
   
    For i = 1 To 12
        ArcTop = CycleT + (13 - i) * StepR
        ArcHeight = StepR * i
        ArcWidth = ArcHeight
        ActiveDocument.Shapes.AddShape(msoShapeArc, ArcLeft, ArcTop, ArcWidth, ArcHeight).Select          '画圆弧256#, 50,
    'Selection.ShapeRange.Flip msoFlipVertical
        Select Case i  '顺时针旋转时，外圈红色
            Case 10 To 12
                Selection.ShapeRange.Adjustments.Item(1) = 45  '调整点
                Selection.ShapeRange.Adjustments.Item(2) = 0    '调整点
            Case 7 To 9
                Selection.ShapeRange.Adjustments.Item(1) = 90  '调整点
                Selection.ShapeRange.Adjustments.Item(2) = 45    '调整点
            Case 4 To 6
                Selection.ShapeRange.Adjustments.Item(1) = 135  '调整点
                Selection.ShapeRange.Adjustments.Item(2) = 90    '调整点
            Case 1 To 3
                Selection.ShapeRange.Adjustments.Item(1) = 180  '调整点
                Selection.ShapeRange.Adjustments.Item(2) = 135    '调整点
            Case 13
                Selection.ShapeRange.Adjustments.Item(1) = 180  '调整点
                Selection.ShapeRange.Adjustments.Item(2) = 0    '调整点
        End Select
       
'        Select Case i  ''顺时针旋转时，内圈红色
'            Case 1 To 3
'                Selection.ShapeRange.Adjustments.Item(1) = 45  '调整点
'                Selection.ShapeRange.Adjustments.Item(2) = 0    '调整点
'            Case 4 To 6
'                Selection.ShapeRange.Adjustments.Item(1) = 90  '调整点
'                Selection.ShapeRange.Adjustments.Item(2) = 45    '调整点
'            Case 7 To 9
'                Selection.ShapeRange.Adjustments.Item(1) = 135  '调整点
'                Selection.ShapeRange.Adjustments.Item(2) = 90    '调整点
'            Case 10 To 12
'                Selection.ShapeRange.Adjustments.Item(1) = 180  '调整点
'                Selection.ShapeRange.Adjustments.Item(2) = 135    '调整点
'            Case 13
'                Selection.ShapeRange.Adjustments.Item(1) = 180  '调整点
'                Selection.ShapeRange.Adjustments.Item(2) = 0    '调整点
'        End Select
       
    Next i
End Sub
 
要使这个陀螺在屏幕上转起来的话，我写了下面的函数，马马虎虎能转，不算理想。转之前记得要将整个陀螺选中并组合起来，不然就转散了。
Sub 转陀螺()
'
' Macro1 Macro
' 宏在 2009-6-6 由 晶晶 录制
'
Dim kdy As Integer, returnArc As Single
kdy = 100
returnArc = 1 * 45 * 0.6 '旋转速度调节
For i = 1 To 1000   '旋转持续时间调节
    Selection.ShapeRange.IncrementRotation returnArc
    If Int(i / kdy) * kdy = i Then DoEvents
Next
End Sub