在窗體中加兩個timer
代碼如下：
'蟲蟲青摘自己互聯網
Option Explicit
'源代碼
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
'GetDC()功能是獲取指定窗體的設備場景的句柄(hDC),用參數0則可以獲取整個屏幕的場景句柄
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
'GetPixel用於取得場景(這裏是整個屏幕)中某點的顏色值
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
'SetPixel用於設置場景(這裏是整個屏幕)中某點的顏色值
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
'釋放由GetDC()獲取的設備場景句柄，否則可能造成系統鎖死
Private Declare Function InvalidateRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long)
'清理窗口雪花
Private Type POINTAPI '定義坐標點結構
x As Long
y As Long
End Type
Private Type RECT '定義“區域”數據結構，但實際上並沒有用到，因為僅需在函數InvalidateRect中傳遞壹個空的RECT參數
left As Long
top As Long
right As Long
bottom As Long
End Type
Dim rect1 As RECT
Private Const ScrnWidth = 1024 '屏幕寬度(單位:像素)
Private Const ScrnHight = 768 '屏幕高度(單位:像素)
Private Const SnowCol = &HFEFFFE '雪花顏色
Private Const SnowColDown = &HFFFFFF '積雪顏色
Private Const SnowColDuck = &HFFDDDD '深色積雪顏色
Private Const SnowNum = 500 '同壹時間飄動的雪花數量
Dim hDC1 As Long '存儲桌面窗口設備句柄
Dim pData(SnowNum) As POINTAPI '存儲每個雪花的位置信息
Dim pColor(SnowNum) As Long '存儲畫出雪花前屏幕原來的顏色
Dim Vx As Integer '雪花總體水平飄行速度
Dim Vy As Integer '雪花總體垂直下落速度
Dim PVx As Integer '單個雪花實際水平飄行速度
Dim PVy As Integer '單個雪花實際垂直飄行速度
'初始化雪花位置
Private Sub InitP(i As Integer)
pData(i).x = Rnd() * ScrnWidth
pData(i).y = Rnd() * 2
pColor(i) = GetPixel(hDC1, pData(i).x, pData(i).y) '取得屏幕原來的顏色值
End Sub
'取得某壹點與周圍點的對比度，確定是否在此位置堆積雪花
Private Function GetContrast(i As Integer) As Long
Dim ColorCmp As Long '存儲用作對比的點的顏色值
Dim tempR As Long '存儲CorlorCmp的紅色部分，下同
Dim tempG As Long
Dim tempB As Long
Dim Slope As Integer '存儲雪花飄落方向:Vx/Vy
'計算雪花飄落方向
If PVy <> 0 Then
Slope = PVx / PVy
Else
Slope = 2
End If
'根據雪花飄落方向決定取哪壹點作對比點，
'若PVx/PVy在-1到1之間，即Slope=0，就取正下面的象素點
'若PVx/PVy>1，取右下方的點，PVx/PVy<-1則取左下方
If Slope = 0 Then
ColorCmp = GetPixel(hDC1, pData(i).x, pData(i).y + 1)
Else
If Slope > 1 Then
ColorCmp = GetPixel(hDC1, pData(i).x + 1, pData(i).y + 1)
Else
ColorCmp = GetPixel(hDC1, pData(i).x - 1, pData(i).y + 1)
End If
End If
'確定當前位置沒有與另壹個雪花重疊，否則返回0，用於防止由於不同雪花重疊造成雪花亂堆
If ColorCmp = SnowCol Then
GetContrast = 0
Exit Function
End If
'分別獲取ColorCmp與對比點的藍、綠、紅部分的差值
tempB = Abs((ColorCmp And &HFF0000) - (pColor(i) And &HFF0000)) / &H10000
tempG = Abs((ColorCmp And &HFF00&) - (pColor(i) And &HFF00&)) / &H100&
tempR = Abs((ColorCmp And &HFF&) - (pColor(i) And &HFF&))
'返回對比度值
GetContrast = (tempR + tempG + tempB) / 3
End Function
'畫出壹幀，即重畫所有雪花位置壹次
Private Sub DrawP()
Dim i As Integer
For i = 0 To SnowNum
'防止雪花重疊造成幹擾
If pColor(i) <> SnowCol Then
'還原上壹個位置的顏色
SetPixel hDC1, pData(i).x, pData(i).y, pColor(i)
End If
'設置新的位置，i Mod 3用於將雪花分為三類采用不同速度，以便形成層次感
PVx = Rnd() * 2 - 1 + Vx * (i Mod 3)
PVy = Vy * (i Mod 3 + 1)
pData(i).x = pData(i).x + PVx
pData(i).y = pData(i).y + PVy
'取得新位置原始顏色值，用於下壹步雪花飄過時恢復此處顏色
pColor(i) = GetPixel(hDC1, pData(i).x, pData(i).y)
'如果獲取顏色失敗，表明雪花已飄出屏幕，重新初始化
If pColor(i) = -1 Then
InitP i
Else
'否則若雪花沒有重疊
If pColor(i) <> SnowCol Then
'若對比度較小(即不能堆積),就畫出雪花
'Rnd()>0.3用於防止某些連續而明顯的邊界截獲所有雪花
If Rnd() > 0.3 Or GetContrast(i) < 50 Then
SetPixel hDC1, pData(i).x, pData(i).y, SnowCol
'否則表明找到明顯的邊界，畫出堆積的雪，並初始化以便畫新的雪花
Else
SetPixel hDC1, pData(i).x, pData(i).y - 1, SnowColDuck
SetPixel hDC1, pData(i).x - 1, pData(i).y, SnowColDuck
SetPixel hDC1, pData(i).x + 1, pData(i).y, SnowColDown
InitP i
End If
End If
End If
Next
End Sub
Private Sub Form_Load()
Dim j As Integer
Me.Caption = "桌面飄雪" '設置窗口標題
'設置計時器，Timer1用於畫單幀，Timer2用於風向變化
Timer1.Enabled = True
Timer1.Interval = 10
Timer2.Enabled = True
Timer2.Interval = 2000
Randomize '初始化隨機數種子
hDC1 = GetDC(0) '獲取桌面窗口設備場景句柄
'初始化整個屏幕
For j = 0 To SnowNum
pData(j).x = Rnd() * ScrnWidth
pData(j).y = Rnd() * ScrnHight
pColor(j) = GetPixel(hDC1, pData(j).x, pData(j).y)
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
ReleaseDC 0, hDC1 '釋放桌面窗口設備句柄
InvalidateRect 0, rect1, 0 '清除所有雪花，恢復桌面
End Sub
Private Sub Timer1_Timer()
DrawP '畫出壹幀
End Sub
Private Sub Timer2_Timer()
'改變風向
Vx = Rnd() * 4 - 2
Vy = Rnd() + 2
End Sub
'完，最後，需要兩個Timer：Timer1、Timer2。