爱华网本软件利用屏幕截图方法截取整个屏幕，然后调用系统api将鼠标设为不显示，最后随机生成白色点。
1、软件组织结构和UI设计：
2、程序源码：
（1）Form1的源码：
Dim WSnow(1000, 1) As Integer
Dim X As Integer
Dim Y As Integer
Dim pos As Integer
Sub Snow()
For i = 0 To 1000
X = Int(60 * Rnd)
Y = Int(100 * Rnd)
WSnow(i, 0) = WSnow(i, 0) + X - 30
WSnow(i, 1) = WSnow(i, 1) + Y
If WSnow(i, 1) > 0 Then
WSnow(i, 1) = WSnow(i, 1) Mod Screen.Height
Me.DrawWidth = Int(2 * Rnd) + 2
Me.PSet (WSnow(i, 0), WSnow(i, 1)), RGB(255, 255, 255)
End If
Next i
End Sub
Public Function CreateBitmapPicture(ByVal hBmp AsLong, ByVal hPal As Long) As Picture
Dim r AsLong
Dim Pic AsPicBmp
Dim IPic AsIPicture
Dim gu AsGUID
Withgu
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
WithPic
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = hBmp
.hPal = hPal
EndWith
r =OleCreatePictureIndirect(Pic, gu, 1, IPic)
SetCreateBitmapPicture = IPic
End Function
Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal ClientAs Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByValWidthSrc As Long, ByVal HeightSrc As Long) As Picture
DimhDCMemory As Long
Dim hBmp AsLong
Dim hBmpPrevAs Long
Dim r AsLong
Dim hDCSrcAs Long
Dim hPal AsLong
Dim hPalPrevAs Long
DimRasterCapsScrn As Long
DimHasPaletteScrn As Long
DimPaletteSizeScrn As Long
Dim LogPalAs LOGPALETTE
If ClientThen
hDCSrc = GetDC(hWndSrc)
Else
hDCSrc = GetWindowDC(hWndSrc)
End If
hDCMemory =CreateCompatibleDC(hDCSrc)
hBmp =CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev =SelectObject(hDCMemory, hBmp)
RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
HasPaletteScrn = RasterCapsScrn And RC_PALETTE
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
IfHasPaletteScrn And (PaletteSizeScrn = 256) Then
LogPal.palVersion = &H300
LogPal.palNumEntries = 256
r = GetSystemPaletteEntries(hDCSrc, 0, 256,LogPal.palPalEntry(0))
hPal = CreatePalette(LogPal)
hPalPrev = SelectPalette(hDCMemory, hPal, 0)
r = RealizePalette(hDCMemory)
End If
r =BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc,TopSrc, vbSrcCopy)
hBmp =SelectObject(hDCMemory, hBmpPrev)
IfHasPaletteScrn And (PaletteSizeScrn = 256) Then
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If
r =DeleteDC(hDCMemory)
r =ReleaseDC(hWndSrc, hDCSrc)
SetCaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function
Public Function CaptureScreen() As Picture
DimhWndScreen As Long
'取得窗体句柄
hWndScreen =GetDesktopWindow()
'捕获窗体
SetCaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width Screen.TwipsPerPixelX, Screen.Height Screen.TwipsPerPixelY)
End Function
Private Sub Form_DblClick()
ShowCursor (1)
End
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift AsInteger)
ShowCursor (1)
End
End Sub
Private Sub Form_Load()
SetForm1.Picture = CaptureScreen()
ShowCursor(0)
Me.DrawWidth= 2
pos =0
For i = 0 To1000
WSnow(i, 0) = Int(Screen.Width * Rnd)
WSnow(i, 1) = -Int(Screen.Height * Rnd)
Next i
App.TaskVisible = False
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer,X As Single, Y As Single)
pos = pos + 1
If pos > 10 Then
ShowCursor (1)
End
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
ShowCursor (1)
End Sub
Private Sub Timer1_Timer()
Me.Refresh
Call Snow
End Sub
（2）Module1.bas源码：
Public Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
peFlags As Byte
End Type
Public Type LOGPALETTE
palVersion As Integer
palNumEntries As Integer
palPalEntry(255) AsPALETTEENTRY
End Type
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Public Const RASTERCAPS As Long = 38
Public Const RC_PALETTE As Long = &H100
Public Const SIZEPALETTE As Long = 104
Public Const vbHiMetric As Integer = 8
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function ShowCursor Lib "user32" (ByVal bShow AsLong) As Long
Public Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDCAs Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "GDI32" (ByValhDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) AsLong
Public Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC AsLong, ByVal iCapabilitiy As Long) As Long
Public Declare Function GetSystemPaletteEntries Lib "GDI32" (ByValhDC As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long,lpPaletteEntries As PALETTEENTRY) As Long
Public Declare Function CreatePalette Lib "GDI32" (lpLogPalette AsLOGPALETTE) As Long
Public Declare Function SelectObject Lib "GDI32" (ByVal hDC AsLong, ByVal hObject As Long) As Long
Public Declare Function BitBlt Lib "GDI32" (ByVal hDCDest As Long,ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long,ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long,ByVal YSrc As Long, ByVal dwRop As Long) As Long
Public Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) AsLong
Public Declare Function GetForegroundWindow Lib "user32" () AsLong
Public Declare Function SelectPalette Lib "GDI32" (ByVal hDC AsLong, ByVal hPalette As Long, ByVal bForceBackground As Long) AsLong
Public Declare Function RealizePalette Lib "GDI32" (ByVal hDC AsLong) As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hWnd AsLong) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) AsLong
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd AsLong, lpRect As RECT) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long,ByVal hDC As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () AsLong
Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll"(PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle AsLong, IPic As IPicture) As Long
Public Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
