桌面下雪

Private Declare Function BitBlt Lib "gdi32" _
        (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, _
        ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
        ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Const SRCCOPY = &HCC0020

Option Explicit
Private Sub CopyScreen()
With Me
    .AutoRedraw = True
    .Width = Screen.Width
    .Height = Screen.Height
       
    .WindowState = 2
    .BorderStyle = 0
End With

BitBlt Me.hDC, 0, 0, Screen.Width / 15, Screen.Height / 15, GetDC(0), 0, 0, SRCCOPY
End Sub
Private Sub fSnow()
Dim Snow(1000, 2), Amounty As Integer
Dim j, Ls, i As Integer
Dim OldX, OldY, Coloury As Long
Form1.Show
DoEvents
Randomize
Amounty = 325
For j = 1 To Amounty
Snow(j, 0) = Int(Rnd * Form1.Width)
Snow(j, 1) = Int(Rnd * Form1.Height)
Snow(j, 2) = 10 + (Rnd * 20)
Next j
Do While Not (DoEvents = 0)
For Ls = 1 To 10
For i = 1 To Amounty
OldX = Snow(i, 0): OldY = Snow(i, 1)
Snow(i, 1) = Snow(i, 1) + Snow(i, 2)
If Snow(i, 1) > Form1.Height Then
Snow(i, 1) = 0: Snow(i, 2) = 5 + (Rnd * 30)
Snow(i, 0) = Int(Rnd * Form1.Width)
OldX = 0: OldY = 0
End If
Coloury = 8 * (Snow(i, 2) - 10): Coloury = 60 + Coloury
PSet (OldX, OldY), vbWhite
PSet (Snow(i, 0), Snow(i, 1)), RGB(Coloury, Coloury, Coloury)
Next i
Next Ls
Loop
End Sub
Private Sub Form_Load()
'拷屏
CopyScreen
'下雪,这个函数写得太粗糙了,大伙凑和看吧,反正不是我写的:)
fSnow
End Sub
'编写窗体的鼠标按下代码,以退出程序:
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Unload Me
End Sub