基于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