vb屏幕下雪小程序.docx

Vb 下雪小程序 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 则取左下方