VB桌面程序.docxVIP

一个让桌面下雪的小程序（并非屏幕保护）1楼以前见到过一个有趣的小程序，叫snow,可以在桌面上下雪，学还可以在窗体边缘、图像边缘堆积，关键是并非屏幕保护，可以边下雪便运行其它程序。?我就用VB模仿了一个。先贴上效果图：2楼源代码?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/PVy1，取右下方的点，