基於VB演算法+Picture+Timer控制元件製作的39種動畫效果,類似屏保（完整原程式） (轉)

基於VB演算法+Picture+Timer控制元件製作的39種動畫效果,類似屏保（完整原程式） (轉)[@more@]

基於VB演算法+Picture+Timer製作的39種動畫效果,類似屏保（完整原）

動畫器程式，在透過，詳細請自行進行學習測試，程式大小13K

下載地址:/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  '上三行初始化
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
Ranize
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", "", "/")
"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