一个让桌面下雪的小程序(并非屏幕保护)
vb吧
全部回复
仅看楼主
level 1
以前见到过一个有趣的小程序,叫snow,可以在桌面上下雪,学还可以在窗体边缘、图像边缘堆积,关键是并非屏幕保护,可以边下雪便运行其它程序。我就用VB模仿了一个。先贴上效果图:
2007年08月24日 07点08分 1
level 1
'源代码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 LongEnd TypePrivate Type RECT '定义“区域”数据结构,但实际上并没有用到,因为仅需在函数InvalidateRect中传递一个空的RECT参数 left As Long top As Long right As Long bottom As LongEnd TypeDim rect1 As RECTPrivate 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() * ScrnWidthpData(i).y = Rnd() * 2pColor(i) = GetPixel(hDC1, pData(i).x, pData(i).y) '取得屏幕原来的颜色值End Sub'取得某一点与周围点的对比度,确定是否在此位置堆积雪花Private Function GetContrast(i As Integer) As LongDim ColorCmp As Long '存储用作对比的点的颜色值Dim tempR As Long '存储CorlorCmp的红色部分,下同Dim tempG As LongDim tempB As LongDim Slope As Integer '存储雪花飘落方向:Vx/Vy'计算雪花飘落方向If PVy <> 0 Then Slope = PVx / PVyElse Slope = 2End 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 IfEnd If'确定当前位置没有与另一个雪花重叠,否则返回0,用于防止由于不同雪花重叠造成雪花乱堆If ColorCmp = SnowCol Then GetContrast = 0 Exit FunctionEnd If'分别获取ColorCmp与对比点的蓝、绿、红部分的差值tempB = Abs((ColorCmp And &HFF0000) - (pColor(i) And &HFF0000)) / &H10000tempG = Abs((ColorCmp And &HFF00&) - (pColor(i) And &HFF00&)) / &H100&tempR = Abs((ColorCmp And &HFF&) - (pColor(i) And &HFF&))'返回对比度值GetContrast = (tempR + tempG + tempB) / 3End Function'下接三楼:
2007年08月24日 07点08分 2
3楼呢
2021年10月23日 02点10分
level 1
说明:基本原理是:先随机取得一个屏幕坐标值(放在pData[i]中),再取得屏幕上对应点原来的颜色存储在pColor[i]中(用函数GetPixel),然后将其设置成雪花的颜色&HFEFFFE(就是画出雪花,用函数SetPixel),到下一个Timer事件时先根据原来存储的pData[i],恢复原来点的颜色,再随机取新的坐标值,重复……从而形成雪花飘动的效果,在此基础上加上判断图像边缘(用自定义的对比度函数GetContrast,它返回与点pData[i]下面相邻的点的颜色值各RGB分量之差的和,当这个差大于某一定值,比如程序中用50,时认为此处到达边缘)、随机、风向等。雪花颜色SnowCol = &HFEFFFE,之所以取这一个值是因为开始时发现有时会出现两个雪花重叠从而造成混乱(也即上下两个雪花相邻,这样下一个雪花会干扰上一个雪花取得屏幕原来颜色),所以将雪花设置成这种接近白色但不如白色FFFFFF常见颜色,当遇到取得的屏幕原始值是SnowCol就认为出现重叠,就跳过这一个Timer事件不进行屏幕操作。另外,我不知道在程序结束时该如何清空雪花、恢复屏幕,后来乱试找到了这个函数:InvalidateRect可以实现这个功能,但原理不明白,望谁能给指教一下。
2007年08月24日 08点08分 4
卤煮,那怎样更改雪花形状,楼主好人
2013年10月26日 06点10分
level 8
顶!!
2007年08月24日 10点08分 5
level 1
支持!!!
2007年08月24日 11点08分 6
level 0
好东西,不错,我顶死楼主,继续奋斗吧
2007年08月24日 16点08分 7
level 6
刚才发帖又被删了…………不错的程序,辛苦楼主了!!!'刷新屏幕用这个………………Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As Any, ByVal bErase As Long) As LongPrivate Sub Command1_Click()InvalidateRect 0, ByVal 0&, TrueEnd Sub
2007年08月25日 01点08分 9
level 0
我是搂主。回9楼,非常感谢指教,确实有用。我还找到了另一种方法:在声明函数“InvalidateRect”时,直接将第二个参数声明成长整型,调用时传参数0,代码如下:Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long Private Sub Command1_Click() InvalidateRect 0, 0, 0 '最后一个参数是True或False(0)似乎都行End Sub'这个方法是不是有些BT?还有,为什么这个函数能重画窗口?我还是不太清楚,因为我有个API函数手册里说InvalidateRect功能是:“使窗口指定区域不活动,并将它加入窗口刷新区,使之可随后被重画”,里面说的“使窗口指定区域不活动”到底是什么意思?不是把指定区域屏蔽了么?这跟刷新屏幕有什么关系?望大家指教。
2007年08月25日 11点08分 10
吧务
level 7
这是我的一个API函数手册中的说明,你看看吧。VB声明 Declare Function InvalidateRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long)Declare Function InvalidateRectBynum& Lib "user32" Alias "InvalidateRect" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) 说明 这个函数屏蔽一个窗口客户区的全部或部分区域。这会导致窗口在事件期间部分重画 返回值 Long,非零表示成功,零表示失败 参数表 参数 类型及说明 hwnd Long,待屏蔽窗口的句柄 lpRect RECT,用于描述待屏蔽矩形部分的一个矩形结构。可用InvalidateRectBynum函数,同时将lpRect设为零(Long数据类型),从而屏蔽(或禁用)整个窗口 bErase Long,TRUE(非零)导致指定的区域在重画前先删除 注解 一旦系统有些更新屏幕的闲置时间可用,windows就会重画窗口
2007年08月25日 14点08分 11
level 0
顶。那么原来的那个程序哪里有下载啊?
2007年09月16日 17点09分 12
level 1
LZ.继续...最好是都加上注释..正好用得上..借用一下,交个作业..可以不LZ>....
2007年09月17日 06点09分 14
level 0
不错..不错..
2007年12月16日 11点12分 15
level 7
好漂亮。。有机会学学
2007年12月16日 14点12分 18
吧务
level 10
历害加精
2007年12月17日 00点12分 19
level 1
随便顶一下
2007年12月17日 06点12分 20
level 1
谢谢楼主,真不错的。
2007年12月17日 08点12分 21
level 1
不错,可以做圣诞节礼物。不过好像CPU占用不高啊?我试验的结果是在打开7个网页、3个资源管理器窗口、另外运行3个像“任务管理器”这样的小程序时,这个程序(按照搂主的代码,没做更改)CPU占用在5-15%之间,CPU总占用率在20-30%之间。另,搂主好似在C语言吧也发过一个C语言版的,其中有些小的错误,不过影响不大:http://post.baidu.com/f?kz=263664044
2007年12月17日 09点12分 22
level 1
呵呵,够我学上一阵的了。感谢楼主开源。
2007年12月17日 11点12分 23
level 13
效果不错,特列精品.(记得吧里很像有人发过却遍寻不着了)
2007年12月17日 15点12分 24
1 2 3 4 5 6 尾页