基于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 = "file:///" & 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