基于VB算法+Picture+Timer控件制作的39种动画效果,类似屏保（完整原程序）

基于VB算法+Picture+Timer控件制作的39种动画效果,类似屏保（完整原程序）

动画播放器程序，在WIN2003调试通过，详细请自行下载进行学习测试，程序大小13K

下载地址:

代码浏览：

Dim xiaoguo As Integer           ´选择产生的效果
Dim wid As Long                  ´显示器的宽
Dim hei As Long                  ´显示器的高
Dim pos1 As Long                 ´产生效果所必须的记数游标
Dim coloris As Integer           ´由用户选择的颜色效果,0=随机任意色,1=随机渐变色
Dim colorstart(2) As Integer     ´当选择随机渐变色时,该数组为了实现随机色彩的记录
Dim heibai As Boolean            ´黑白对比色时,决定是否走向黑的或白的一面
Dim heibaicolor As Integer       ´范围0-255,为了记录黑白对比色,黑白渐淡色,黑百渐浓色的灰度
Dim lihe As Boolean              ´为完成天地之吻,沉睡之心做出离合判断
Dim pos2 As Long                 ´为完成地狱之火做出持续的喷放效果
Dim xx() As Long                 ´为完成生命繁衍，计算球体向右的移动量
Dim yy() As Long                 ´为完成生命繁衍，计算球体向下的移动量
Dim jiaX() As Boolean            ´为完成生命繁衍，计算是否增加或减少XX
Dim jiaY() As Boolean            ´为完成生命繁衍，计算是否增加或减少YY
Dim rectmax As Integer           ´为完成“数据阵列”，计算X，Y的最大阵列
Dim hang As Integer              ´为完成“现代言论”，计算到了第几行了
Dim pos3 As Long                 ´为完成“旋转光线”，计算第二条线的移动偏差
Dim bcolor As String             ´为历史记录保存画布的背景颜色

Private Sub Command1_Click(Index As Integer)   ´39个按钮接收到单击事件时（初始化效果）
p.Cls: p.CurrentX = 0: p.CurrentY = 0: pos1 = 0: pos2 = 0: p.FillColor = bcolor
p.FontSize = 9: p.FontBold = False: p.BackColor = bcolor: lihe = False
p.FillStyle = 1: pos3 = 0        ´上三行初始化播放器
Select Case Index
Case 5: p.DrawWidth = 10         ´DrawWidth定义线段的粗度
Case 7: p.DrawWidth = 8
Case 8: p.DrawWidth = 9
Case 9: p.DrawWidth = 3
Case 10: p.DrawWidth = 3
Case 11: p.DrawWidth = 3
Case 12: p.DrawWidth = 3
Case 13: p.DrawWidth = 3
Case 14: p.DrawWidth = 6
Case 15: p.DrawWidth = 3
Case 16: p.DrawWidth = 3
Case 17: p.DrawWidth = 3
Case 18: p.DrawWidth = 5
Case 19:
ReDim xx(5): ReDim yy(5): ReDim jiaX(5): ReDim jiaY(5)   ´为实现多线程,初始化线程存储数组
For i = 0 To 4
Randomize
xx(i) = wid * Rnd: yy(i) = hei * Rnd
Next: p.DrawWidth = 1
Case 21: p.DrawWidth = 3
Case 22: rectmax = Round(Rnd * 50): p.DrawWidth = 1
Case 23: p.FontSize = 12: p.FontBold = True: hang = 1
Case 26: p.FontSize = 12: p.FontBold = True
Case 27
ReDim xx(5): ReDim yy(5): ReDim jiaX(5): ReDim jiaY(5)
For i = 0 To 4
Randomize
xx(i) = wid * Rnd: yy(i) = hei * Rnd
Next: p.DrawWidth = 1: p.BackColor = vbBlack
Case 29: p.DrawWidth = 50
Case 31: ReDim xx(5): ReDim yy(5): ReDim jiaX(5): ReDim jiaY(5)
xx(0) = wid * Rnd: yy(0) = hei * Rnd: p.DrawWidth = 1
Case 33: p.DrawWidth = 5
Case 34: p.DrawWidth = 1
Case 37: p.FillStyle = 0: p.DrawWidth = 2
Case Else
p.DrawWidth = 1
End Select
xiaoguo = Index: Timer1.Enabled = True    ´开始运行播放器
End Sub

Private Sub Form_Load()
xiaoguo = 0: p.BackColor = vbWhite: bcolor = vbWhite
For i = 0 To 2: colorstart(i) = Round(Rnd * 255): Next   ´启动时生成三个随机原色
End Sub
 
Private Sub Form_Resize()                  ´窗体移动时改变控件布局以及部分参数设置
On Error Resume Next
p.Width = Me.ScaleWidth - 200: Frame1.Top = Me.ScaleHeight - Frame1.Height - 100
p.Height = Frame1.Top - 100
If Me.ScaleWidth > Frame1.Width Then
Frame1.Left = Me.ScaleWidth / 2 - Frame1.Width / 2
End If
s.Top = p.Top + p.Height - s.Height
wid = p.Width: hei = p.Height
End Sub

Private Sub menu01_Click(Index As Integer)     ´控制菜单中菜单列的单击
Select Case Index
Case 1: Timer1.Enabled = Not Timer1.Enabled    ´播放/停止
Case 2:           ´下一效果
If xiaoguo = Command1.Count - 1 Then xiaoguo = 0 Else xiaoguo = xiaoguo + 1
Command1_Click xiaoguo
Case 3:           ´下一颜色系
For i = 0 To Option1.Count - 1
If Option1(i).Value = True Then Exit For
Next
If i = Option1.Count - 1 Then Option1(0).Value = True Else Option1(i + 1).Value = True
Case 4:           ´设置背景
str1 = InputBox("请输入一个颜色代码,“&H蓝绿红”色系,原色参数00-ff之间", "背景设置", Hex(p.BackColor))
If str1 = "" Then Exit Sub
On Error Resume Next
oldcolor = p.BackColor: p.BackColor = "&h" & str1
If Err.Number <> 0 Then MsgBox "无效的背景颜色参数！", vbCritical, "错误参数": p.BackColor = oldcolor
bcolor = p.BackColor
Case 5: p.Cls                                  ´清除画布
Case 6: s.Visible = Not s.Visible              ´显示/隐藏速度控制
Case 8:                                        ´保存画布图形为图片
If InStr(App.Path, "\") = Len(App.Path) Then path1 = App.Path Else path1 = App.Path & "\"
SavePicture p.Image, path1 & "效果图片" & xiaoguo & ".jpg"
path2 = "" & Replace(path1 & "效果图片" & xiaoguo & ".jpg", "\", "/")
Shell "explorer " & path2, vbMaximizedFocus    ´在WIN2003下无知为何不能正常在浏览器运行
End Select
End Sub

Private Sub p_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu menu1  ´弹出菜单
End Sub

Private Sub s_Change()     ´加快或减慢播放速度
Timer1.Interval = s.Value
End Sub

Private Sub Option1_Click(Index As Integer)    ´颜色效果单选按钮数组的单击
coloris = Index
End Sub

Private Sub Timer1_Timer()  ´播放循环计时器开始运行,以下39例效果算法未经我仔细检查,完全可以在次优化
Randomize
Select Case coloris
Case 0                     ´应用随机任意色
color1 = RGB(Round(Rnd * 255), Round(Rnd * 255), Round(Rnd * 255))
Case 1                     ´应用随机渐淡色
For i = 0 To 2
If colorstart(i) > 254 Then colorstart(i) = Round(Rnd * 255) Else colorstart(i) = colorstart(i) + 1
Next
color1 = RGB(colorstart(0), colorstart(1), colorstart(2))
Case 2                     ´应用随机渐浓色
For i = 0 To 2
If colorstart(i) < 1 Then colorstart(i) = Round(Rnd * 255) Else colorstart(i) = colorstart(i) - 1
Next
color1 = RGB(colorstart(0), colorstart(1), colorstart(2))
Case 3                     ´黑白对比色
If heibai = False Then
If heibaicolor > 254 Then heibai = True Else heibaicolor = heibaicolor + 1
Else
If heibaicolor < 1 Then heibai = False Else heibaicolor = heibaicolor - 1
End If
color1 = RGB(heibaicolor, heibaicolor, heibaicolor)
Case 4                     ´黑白渐淡色
If heibaicolor > 254 Then heibaicolor = Round(Rnd * 255) Else heibaicolor = heibaicolor + 1
color1 = RGB(heibaicolor, heibaicolor, heibaicolor)
Case 5                     ´黑白渐浓色
If heibaicolor < 1 Then heibaicolor = Round(Rnd * 255) Else heibaicolor = heibaicolor - 1
color1 = RGB(heibaicolor, heibaicolor, heibaicolor)
End Select

Select Case xiaoguo
Case 0   ´横向线条
rnd1 = Round(Rnd * hei)
p.Line (0, rnd1)-(wid, rnd1), color1
Case 1   ´竖向线条
rnd1 = Round(Rnd * wid)
p.Line (rnd1, 0)-(rnd1, hei), color1
Case 2   ´右向辐射
p.Line (0, 0)-(Round(Rnd * wid), Round(Rnd * hei)), color1
Case 3   ´密集辐射
rnd1 = Round(Rnd * wid): rnd2 = Round(Rnd * hei)
p.Line (0, 0)-(rnd1, rnd2), color1
p.Line (0, hei)-(rnd1, rnd2), color1
p.Line (wid, 0)-(rnd1, rnd2), color1
p.Line (wid, hei)-(rnd1, rnd2), color1
Case 4   ´内部扩散
p.Line (wid / 2, hei / 2)-(wid * Rnd, hei * Rnd), color1
Case 5   ´左右扩展
If pos1 * 2 < wid Then pos1 = pos1 + 25 Else pos1 = 1
If pos1 Mod 2 <> 0 Then   ´如果是奇数则向右扩展,否则向左
p.Line (wid / 2 + pos1, 0)-(wid / 2 + pos1, hei), color1
Else
p.Line (wid / 2 - pos1, 0)-(wid / 2 - pos1, hei), color1
End If
Case 6   ´随机线段
rnd1 = wid * Rnd: rnd2 = hei * Rnd
rnd3 = Rnd * 1000: If rnd3 < 500 Then rnd3 = -rnd3
rnd4 = Rnd * 1000: If rnd4 < 500 Then rnd4 = -rnd4
For i = 0 To 3: p.Line (rnd1, rnd2)-(rnd1 + rnd3, rnd2 + rnd4), color1: Next
Case 7   ´随机颗粒
For i = 0 To 3: p.PSet (wid * Rnd, hei * Rnd), color1: Next
Case 8   ´虚拟葫芦
rnd1 = wid * Rnd: rnd2 = hei * Rnd
For i = 0 To 5
temp1 = 8 + (i * 3)
p.DrawWidth = temp1
p.PSet (rnd1 + (temp1 * 6 * i), rnd2 + (temp1 * 6 * i)), color1
Next
Case 9   ´三维十字
wid1 = wid / 2: hei1 = hei / 2
If pos1 * 2 < wid Then pos1 = pos1 + 7 Else pos1 = 1
If pos1 Mod 2 = 0 Then
p.Line (wid1 + pos1, 0)-(wid1 + pos1, hei), color1
p.Line (0, hei1 + pos1)-(wid, hei1 + pos1), color1
Else
p.Line (wid1 - pos1, 0)-(wid1 - pos1, hei), color1
p.Line (0, hei1 - pos1)-(wid, hei1 - pos1), color1
End If
Case 10  ´X型极光
If pos1 * 2 < wid Then pos1 = pos1 + 21 Else pos1 = 1
If pos1 Mod 2 = 0 Then
p.Line (0 + pos1, 0)-(wid + pos1, hei), color1
p.Line (wid + pos1, 0)-(0 + pos1, hei), color1
Else
p.Line (0 - pos1, 0)-(wid - pos1, hei), color1
p.Line (wid - pos1, 0)-(0 - pos1, hei), color1
End If
Case 11  ´金字魔塔
wid1 = wid / 2: hei1 = hei / 2
If pos1 * 3 < wid Then pos1 = pos1 + 15 Else pos1 = 1
p.Line (wid1, hei1 - pos1)-(wid1 + (pos1 * 2), hei1 + pos1), color1
p.Line -(wid1 - (pos1 * 2), hei1 + pos1), color1
p.Line -(wid1, hei1 - pos1), color1
Case 12  ´天地之吻
If pos1 * 2 > hei Then lihe = False
If pos1 < 25 Then lihe = True
If lihe = False Then pos1 = pos1 - 20 Else pos1 = pos1 + 20
p.Line (0, 0 + pos1)-(wid, 0 + pos1), color1
p.Line (wid, hei - pos1)-(0, hei - pos1), color1
Case 13  ´堕落天使
If pos1 < hei Then pos1 = pos1 + 5 Else pos1 = 0
rnd1 = wid * Rnd
p.Line (rnd1, pos1)-(rnd1, pos1 + (500 * Rnd)), color1
p.Line (0, pos1 - 800)-(wid, pos1 - 800), p.BackColor
Case 14  ´地狱之火
If pos1 < hei Then pos1 = pos1 + 7 Else pos1 = 0
wid1 = wid / 2
If pos1 > hei / 2 Then    ´绘制火山
pos2 = pos1
Else
p.Line (wid1 - 800, hei)-(wid1, hei - 500), color1
p.Line -(wid1 + 800, hei), color1
End If
pos2 = pos2 + 1: p.PSet (wid1 + (pos2 * (Rnd - 0.5)), hei - 500 - (pos2 * (Rnd + 0.4))), color1
p.PSet (wid1 + (pos1 * (Rnd - 0.5)), hei - 500 - (pos1 * (Rnd + 0.4))), color1
Case 15  ´流金岁月
If pos1 > -hei Then pos1 = pos1 - 5 Else pos1 = 0
rnd1 = wid * Rnd: rnd2 = hei * Rnd
p.Line (rnd1, hei + pos1)-(rnd1, hei + pos1 - (Rnd * 500)), color1
p.Line (rnd1, rnd2)-(rnd1, rnd2 + (Rnd * 500)), p.BackColor
Case 16  ´光环之舞
If pos1 < 300 Then pos1 = pos1 + 15 Else pos1 = 0: If pos2 < 299 Then pos2 = 300
wid1 = wid / 2: hei1 = hei / 2
p.Line (pos1, pos1)-(wid - pos1, hei - pos1), color1, B
If pos2 < 299 Then
p.Circle (wid1, hei1), pos1, color1, , , 1
Else
pos2 = pos2 + 15
If pos2 > hei Then pos2 = 0: pos1 = 0: p.Cls
p.Circle (wid1, hei1), pos2, color1, , , 1
End If
Case 17  ´成长衰亡
wid1 = wid / 2: hei1 = hei / 2
If pos1 > hei1 Then lihe = False
If pos1 < 10 Then lihe = True
If lihe = False Then
p.Circle (wid1, hei1), pos1, p.BackColor
pos1 = pos1 - 10
Else
pos1 = pos1 + 10
p.Circle (wid1, hei1), pos1, color1, , , Abs(Rnd + 0.5)
End If
Case 18  ´光之冲撞
wid1 = wid / 2: hei1 = hei / 2: rnd1 = Rnd * 200
If pos1 < wid Then pos1 = pos1 + 20 Else p.Cls: pos1 = 0: pos2 = 0
If rnd1 < 100 Then rnd1 = -(rnd1 - 50) Else rnd1 = rnd1 - 50
p.Line (pos1, hei1 + rnd1)-(pos1 + 100, hei1 + rnd1), color1
p.Line (wid - pos1, hei1 + rnd1)-(wid - pos1 - 100, hei1 + rnd1), -color1
If pos1 > wid / 2 Then pos2 = pos2 + 20: p.Circle (wid1, hei1), pos2, color1, , , Rnd
Case 19  ´生命繁衍
p.Cls: pos1 = pos1 + 1
If pos1 Mod 50 = 0 And UBound(xx) < 500 Then
temp1 = UBound(xx) + 1
ReDim Preserve xx(temp1): ReDim Preserve yy(temp1)
ReDim Preserve jiaX(temp1): ReDim Preserve jiaY(temp1)
xx(temp1) = wid * Rnd: yy(temp1) = hei * Rnd
End If
For i = 0 To UBound(xx)
If hei - yy(i) < 150 Then jiaY(i) = False
If wid - xx(i) < 150 Then jiaX(i) = False
If yy(i) < 150 Then jiaY(i) = True
If xx(i) < 150 Then jiaX(i) = True
If jiaY(i) = True Then yy(i) = yy(i) + 50 Else yy(i) = yy(i) - 50
If jiaX(i) = True Then xx(i) = xx(i) + 50 Else xx(i) = xx(i) - 50
p.Circle (xx(i), yy(i)), 200, color1
Next
Case 20  ´起起落落
If pos1 < 20 Then lihe = True
If pos1 > hei - 2500 Then lihe = False
If lihe = False Then pos1 = pos1 - 30 Else pos1 = pos1 + 30
p.Cls
wid1 = wid / 2: hei1 = hei / 2
p.Line (wid1 - 800, hei - 500)-(wid1 + 800, hei), color1, BF
p.Circle (wid1, hei - 1500 - pos1), 1000, -color1, , , 1
Case 21  ´三维空间
wid1 = wid / 2: hei1 = hei / 2
If pos1 < wid1 Then pos1 = pos1 + (wid1 / 200): pos2 = pos2 + (hei1 / 200) Else pos1 = 1: pos2 = 1
p.Line (wid1 - pos1, hei1 - pos2)-(wid1 + pos1, hei1 - pos2), color1
p.Line -(wid1 + pos1, hei1 + pos2), color1
p.Line -(wid1 - pos1, hei1 + pos2), color1
p.Line -(wid1 - pos1, hei1 - pos2), color1
Case 22  ´数据阵列
If pos2 >= (rectmax / 2) Then pos2 = 0: p.Cls: rectmax = Round(Rnd * 30) + 1
rnd1 = wid / rectmax: rnd2 = hei / (rectmax / 2)
If pos1 <= rectmax Then pos1 = pos1 + 1 Else pos1 = 0: pos2 = pos2 + 1
p.Line (rnd1 - rnd1 * pos1, rnd2 * pos2)-(rnd1 * pos1, rnd2 * pos2 + rnd2), color1, B
Case 23  ´现代言论
str1 = "命运像宇宙星体的运行一般，是那么的有形无型，灵魂经过许多次的剧烈幢击后，已经是伤痕累累，" & _
"虽然剥去了耀眼的美丽，但却显的那样的脱俗那样的勇敢，它在也不会轻易的流泪|欲望的深渊只有用利益去" & _
"填补，就像饥饿的身体只有食物来满足一样，它实在太可怕也太具诱惑了，没有人是你真正的亲人哪、世上" & _
"根本没有无私的存在、没有真情、没有真爱，总之一切的美都是虚伪的只有欲望是真实的，只有风是你真正的" & _
"亲人，只有阳光是真正无私的。。"
If 100 * Rnd > 20 Then Exit Sub
p.ForeColor = color1
If pos1 < Len(str1) Then pos1 = pos1 + 1: pos2 = pos2 + 1 Else pos1 = 1: hang = 1: pos2 = 1: p.Cls
txt1 = Mid(str1, pos1, 1)
If txt1 = "，" Or txt1 = "、" Then
pos2 = 0: hang = hang + 1
ElseIf txt1 = "|" Then
pos2 = 0: hang = 1: p.Cls
Else
p.CurrentX = p.Font.Size * 20 * pos2: p.CurrentY = p.Font.Size * 20 * hang
p.Print txt1
End If
Case 24  ´旋转光环
If pos1 > hei / 10 Then lihe = False
If pos1 < 20 Then lihe = True
If lihe = True Then
pos1 = pos1 + 10: col1 = color1: col2 = -color1
Else
pos1 = pos1 - 10: col1 = -color1: col2 = color1
End If
p.Cls: wid1 = wid / 2: hei1 = hei / 2
temp1 = hei / 3 - pos1
p.Circle (wid1, hei1 - (temp1 / 3) + (pos1 * 3.5)), temp1, col1, , , pos1 / (hei / 10)
p.Circle (wid1, hei1 + (temp1 / 3) - (pos1 * 3.5)), temp1, col2, , , pos1 / (hei / 10)
Case 25  ´密集电网
If pos1 < hei Then pos1 = pos1 + 20 Else pos1 = 1
p.Line (0, hei - pos1)-(wid, hei), color1
p.Line (0, 0)-(wid, pos1), color1
p.Line (0, hei)-(wid, hei - pos1), color1
p.Line (wid, 0)-(0, pos1), color1
Case 26  ´滚动台词
str1 = "鱼儿失去了池塘，蚊虫困在了蛛网，抹不去的痕迹逃不掉的结局，无力的挣扎绝望的将近，虽然“静”" & _
"给我指引了迷途，让我勇敢的走下去，但内心实在太空虚太劳累，一次一次的痛强忍过后，灵魂的创伤却无法" & _
"愈合|我曾选择过睡觉、玩游戏逃避所有的痛，但却不忘告戒自己“最后一次”，不知多少次的“最后一次”，" & _
"逃避之后更难以忍受自己所做的行为，自责甚至骂自己是懦夫是邪恶的战俘，但具诱惑的解脱堕落最终我没有" & _
"去尝试，最中我还是选择了继续的压抑和勇敢的走下去，这种选择希望是属于每个人的"
If pos1 < hei + (p.FontSize * 20 * pos2) Then pos1 = pos1 + 10 Else pos1 = 1: pos2 = 0
p.Cls: p.ForeColor = color1
If pos2 = 0 Then        ´计算逗号个数,为了增加滚动时限
i = 1
While InStr(i, str1, "，") <> 0
temp1 = InStr(i, str1, "，")
pos2 = pos2 + 1: i = temp1 + 1
Wend
End If
p.CurrentY = hei - pos1: p.Print Replace(Replace(str1, "，", vbCrLf), "|", vbCrLf & vbCrLf)
Case 27  ´夜空流星
p.Cls
If UBound(xx) < 200 Then
temp1 = UBound(xx) + 1: ReDim Preserve xx(temp1): ReDim Preserve yy(temp1)
ReDim Preserve jiaX(temp1): ReDim Preserve jiaY(temp1)
xx(temp1) = wid * Rnd: yy(temp1) = hei * Rnd
End If
For i = 0 To UBound(yy)
If yy(i) > hei + 500 Then yy(i) = 0
If xx(i) < -500 Then xx(i) = wid * Rnd + hei
yy(i) = yy(i) + 30: xx(i) = xx(i) - 30
p.Line (xx(i), yy(i))-(xx(i) + 500, yy(i) - 500), color1
Next
Case 28  ´随机变形
If 100 * Rnd < 80 Then Exit Sub
wid1 = wid / 2: hei1 = hei / 2: rnd1 = Round(Rnd * 3) + 1: p.Cls
For i = 0 To rnd1
If i = 0 Then
p.Line (wid1 - 500, hei1 - 500)-(wid1 + 500, hei1 - 500), color1
ElseIf i = rnd1 Then
p.Line -(wid1 + 500, hei1 + 500), color1
p.Line -(wid1 - 500, hei1 + 500), color1: p.Line -(wid1 - 500, hei1 - 500), color1
Else
p.Line -(wid * Rnd, hei * Rnd), color1
End If
Next
Case 29  ´天狼啄月
wid1 = wid / 2: hei1 = hei / 2
If pos1 = 0 Then
p.Cls
For i = 1 To 20
p.Circle (wid1, hei1), hei1 / 1.5 - (i * (hei1 / 32)), color1
Next
End If
If pos1 > wid1 / 2 Then pos1 = 0 Else pos1 = pos1 + 20
p.Circle (wid1 - (hei1 / 1.7), hei - (hei1 / 1.7)), pos1, p.BackColor
Case 30  ´旋转光线
pos1 = pos1 + 5: wid1 = wid / 2: p.Cls
If pos2 >= wid1 Then pos1 = 0: pos2 = 0
If pos1 Mod 600 = 0 Then
lihe = False
ElseIf pos1 Mod 300 = 0 Then
lihe = True
End If
If lihe = False Then pos2 = pos2 + ((pos1 / 250) * 10) Else pos2 = pos2 - ((pos1 / 250) * 10)
p.Line (wid1 - pos2, 0)-(wid1 - pos2, hei), color1
p.Line (wid1 + pos2, 0)-(wid1 + pos2, hei), -color1
Case 31  ´光之轨迹
If xx(0) < 500 Then jiaX(0) = True
If yy(0) < 500 Then jiaY(0) = True
If wid - xx(0) < 500 Then jiaX(0) = False
If hei - yy(0) < 500 Then jiaY(0) = False
If jiaX(i) = True Then xx(0) = xx(0) + 500 Else xx(0) = xx(0) - 500
If jiaY(i) = True Then yy(0) = yy(0) + 500 Else yy(0) = yy(0) - 500
If lihe = False Then
p.Line (xx(0), yy(0))-(xx(0), yy(0)), color1
lihe = True
Else
p.Line -(xx(0), yy(0)), color1
End If
Case 32  ´旋转回忆
If InStr(App.Path, "\") = Len(App.Path) Then path1 = App.Path Else path1 = App.Path & "\"
str1 = path1 & "甩哥.jpg"
Set pic1 = LoadPicture(str1): p.Cls: wid1 = wid / 2: hei1 = hei / 2
If pos1 < wid Then pos1 = pos1 + 10 Else pos1 = 0
If pos1 Mod 4000 = 0 Then
lihe = False
ElseIf pos1 Mod 2000 = 0 Then
lihe = True
End If
If lihe = True Then
pos2 = pos2 - 30
If pos2 < 40 Then lihe = False
Else
pos2 = pos2 + 30
End If
p.PaintPicture pic1, pos1, hei1 - (pic1.Height / 4), pos2
p.PaintPicture pic1, wid1 - (pic1.Width / 4), pos1 / 2, , (pos2 / 2)
p.PaintPicture pic1, wid - pos1, hei1 - (pic1.Height / 4), -pos2
p.PaintPicture pic1, wid1 - (pic1.Width / 4), hei - (pos1 / 2), , -(pos2 / 2)
Case 33  ´阿基米一
wid1 = wid / 2: hei1 = hei / 2:
If pos2 = 0 Then pos2 = Round(Rnd * 8) + 1
If pos1 < wid1 - (wid1 - hei1) Then pos1 = pos1 + 30 Else pos1 = 1: pos2 = 0: p.Cls: Exit Sub
For i = 0 To pos1 Step pos2
i = i + pos2
p.PSet (i * Cos(i) + wid1, i * Sin(i) + hei1), color1
Next
Case 34  ´阿基米二
wid1 = wid / 2: hei1 = hei / 2:
If pos1 < wid1 Then pos1 = pos1 + 10 Else pos1 = 1: pos2 = 0: p.Cls: Exit Sub
p.Line (wid1, hei1)-(pos1 * Cos(pos1) + wid1, pos1 * Sin(pos1) + hei1), color1
Case 35  ´阿基米三
wid1 = wid / 2: hei1 = hei / 2
If pos1 < wid1 Then pos1 = pos1 + 10 Else pos1 = 20: p.Cls: Exit Sub
p.Circle (wid1, hei1), pos1, color1
p.Line (wid1, hei1)-(pos1 * Cos(pos1) + wid1, pos1 * Sin(pos1) + hei1), -color1, BF
Case 36  ´声波探测
hei1 = hei / 2
If Rnd * 100 < 20 Then rnd1 = Rnd * hei1
If pos1 < wid Then pos1 = pos1 + 50 Else pos1 = 50: p.Cls
If pos1 = 50 Then
p.Line (pos1, rnd1 * Cos(rnd1) + hei1)-(pos1 + 50, rnd1 * Sin(rnd1) + hei1), color1
Else
p.Line -(pos1, rnd1 * Cos(rnd1) + hei1), color1
End If
Case 37  ´光辉四射
wid1 = wid / 2: hei1 = hei / 2: rnd1 = Rnd * wid1: rnd2 = hei1 / 5
If pos1 < wid1 Then pos1 = pos1 + (Rnd * 10) Else pos1 = 0
p.Line (rnd1 * Cos(pos1) + wid1, rnd1 * Sin(pos1) + hei1)-((Cos(pos1) * rnd2) + wid1, (Sin(pos1) * rnd2) + hei1), color1
p.FillColor = color1
p.Circle (wid1, hei1), rnd2, color1
Case 38  ´网状距阵
If pos1 < wid Then pos1 = pos1 + 10 Else pos1 = 0: p.Cls
color2 = 0
If pos1 = 0 Then
pos2 = Round(Rnd * 7): pos3 = color1
ElseIf pos1 Mod 100 = 0 Then
pos2 = Round(Rnd * 7): pos3 = color1: p.Cls
End If
While pos2 = 0
pos2 = Round(Rnd * 7)
Wend
p.FillStyle = pos2: p.FillColor = pos3
p.Line (0, 0)-(wid, hei), pos3, B
Case 39  ´圆形光线
wid1 = wid / 2: hei1 = hei / 2
If pos1 < wid1 Then pos1 = pos1 + 10 Else pos1 = 10: p.Cls
If pos1 = 10 Then
p.Line (wid1, hei1)-(wid1, hei1), color1
Else
p.Line -(pos1 * Sin(pos1) + wid1, pos1 * Cos(pos1) + hei1), color1
End If
End Select
End Sub

原文转自：http://www.ltesting.net