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

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

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

下载地址:http://www.lshdic.com/download/lshdic/vb_xiaoguo.rar

代码浏览：

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