VB整人小程序：让整个屏幕雪花飘飘(改进)

当前位置：首页VB小程序让整个屏幕雪花飘飘（改进）58.VB整人小程序：让整个屏幕雪花飘飘（改进）这是我以前写的小程序让整个屏幕雪花飘飘的改进，本程序是一个模拟下雪的小程序：大小不同随风飘荡的雪花从屏幕上方不断落下，飘满整个屏幕。雪花可在任何窗口上飘荡，包括任务栏、开始菜单、弹出菜单等地方。本程序与原程序的主要改进之处是：落下的雪花不会消失，会在屏幕底部不断堆积，双击屏幕底部的积雪可使积雪消失。本程序编译成exe文件运行后，只能通过系统“任务管理器”才能终止运行。程序运行效果截图如下:'''本程序包含两个窗体，Form1和Form2，其中Form1是启动窗体。代码在在VB6调试通过：''下面是Form1窗体代码：=====================================''注意：在属性窗口将窗体的BorderStyle属性设置为0，即窗体是无边框窗体''在窗体上放置一个控件：Timer1，不必设置任何属性''本人原创，转载请注明文章来源：(ByValhWndAsLong,ByValhWndInsertAfterAsLong,ByValXAsLong,ByValYAsLong,ByValcxAsLong,ByValcyAsLong,ByValwFlagsAsLong)AsLongPrivateDeclareFunctionSetLayeredWindowAttributesLibuser32(ByValhWndAsLong,ByValcrKeyAsLong,ByValbAlphaAsByte,ByValdwFlagsAsLong)AsLongPrivateDeclareFunctionGetWindowLongLibuser32AliasGetWindowLongA(ByValhWndAsLong,ByValnIndexAsLong)AsLongPrivateDeclareFunctionSetWindowLongLibuser32AliasSetWindowLongA(ByValhWndAsLong,ByValnIndexAsLong,ByValdwNewLongAsLong)AsLongDimctSnow()AstySnow,ctSnowSAsLong,ctSeChangeAsLongPrivateTypetySnow'定义表示雪花的数据类型XAsSingle:xVAsSingle'x坐标、水平移动速度YAsSingle:yVAsSingle'y坐标、垂直移动速度SeAsLong:SizeAsSingle'雪花颜色、大小EndTypePrivateSubForm_Load()ctSnowS=200'300'雪花数量ctSeChange=30'雪花颜色的变化范围'最大化窗口。注意：不要用在属性窗口设置WindowState属性的方'式，也不使用Me.WindowState=2代码。否则，在用户调整任务'栏状态的时候，会造成积雪的位置错位。Me.WindowState=0Me.Move0,0,Screen.Width,Screen.HeightReDimctSnow(1ToctSnowS)Me.Caption=雪花飘飘Me.AutoRedraw=True:Me.ScaleMode=3Me.BackColor=RGB(235-ctSeChange*2,235-ctSeChange*2,255)CallTransWin(Me.hWnd,Me.BackColor)'将窗口背景色设置为透明的Form2.AutoRedraw=True:Form2.ScaleMode=3Form2.BackColor=Me.BackColorForm2.MoveForm1.Left,Form1.Top,Form1.Width,Form1.HeightCallTransWin(Form2.hWnd,Form2.BackColor)'将窗口背景色设置为透明的Form2.ShowTimer1.Enabled=True:Timer1.Interval=20EndSubPrivateSubTimer1_Timer()DimIAsLong,VAsSingle,H1AsSingle,IsDownAsBoolean,SeAsLongV=8'修改此数字，可改变雪花整体飘荡的速度Randomize'初始化随机发生器WinInTopMe.hWnd,True'使雪花（窗口）显示在最前，包括显示到任务栏上面WinInTopForm2.hWnd,TrueMe.Line(0,0)-(Me.ScaleWidth,Me.ScaleHeight),Me.BackColor,BFForI=1ToctSnowSctSnow(I).X=ctSnow(I).X+ctSnow(I).xV*VctSnow(I).Y=ctSnow(I).Y+ctSnow(I).yV*VIfRnd*201ThenctSnow(I).xV=Rnd-0.5'改变水平移动速度，模拟随风飘荡IfctSnow(I).Size=0OrctSnow(I).YMe.ScaleHeightThenCallSnowInit(I)'未初始化，或超出下边界'ctSnow(I).Size=2'****调试代码ShowStrMe,I'画一朵雪花Me.Font.Size=ctSnow(I).SizeH1=Me.TextHeight(*)*0.5'半个字符高度IfctSnow(I).X-H1ThenctSnow(I).X=Me.ScaleWidth'超出左边界IfctSnow(I).XMe.ScaleWidthThenctSnow(I).X=-H1'超出右边界'最下层积雪位置IsDown=ctSnow(I).YMe.ScaleHeight-H1IfIsDownThenctSnow(I).Y=Me.ScaleHeight-H1'积雪密度:Y坐标后H1*0.9数值越小密度越大'数值过大，如H1*1.5，会使积雪堆积成柱状或造成空隙。'数值过小，如H1*0.5，会使积雪堆积速度缓慢。Se=Form2.Point(ctSnow(I).X+H1*0.5,ctSnow(I).Y+H1*0.9)IfSe-1AndSeForm2.BackColorThenIsDown=True'已落到最下面，在Form2的相同位置绘制积雪IfIsDownThenShowStrForm2,ICallSnowInit(I)IfctSnow(I).YMe.ScaleHeight*0.9ThenForm2.Font.Size=12Form2.CurrentX=(Me.ScaleWidth-8*Me.TextHeight(12))*0.5Form2.CurrentY=Me.ScaleHeight*0.92Form2.ForeColor=RGB(0,0,255)Form2.Print双击此处消除积雪EndIfEndIfNextEndSubPrivateSubShowStr(Kj,IAsLong)'画一朵雪花DimH1AsSingleKj.Font.Size=ctSnow(I).SizeKj.CurrentX=ctSnow(I).XKj.CurrentY=ctSnow(I).YKj.ForeColor=ctSnow(I).SeIfctSnow(I).Size4.2ThenKj.Print*ElseIfctSnow(I).Size3ThenKj.DrawWidth=2ElseKj.DrawWidth=1H1=Kj.TextHeight(*)*0.5Kj.PSet(ctSnow(I).X+H1*0.5,ctSnow(I).Y+H1-1)EndIfEndSubPrivateSubSnowInit(IAsLong)'初始化一朵雪花DimSAsSinglectSnow(I).X=Rnd*Me.ScaleWidthctSnow(I).xV=Rnd-0.5ctSnow(I).yV=Rnd*0.5+0.1S=2+Rnd*9'字体最大11号IfctSnow(I).Size=0ThenctSnow(I).Y=Rnd*Me.ScaleHeightElseMe.Font.Size=SctSnow(I).Y=-Me.TextHeight(*)EndIfctSnow(I).Size=SS=235-ctSeChange*2+Int(Rnd*ctSeChange*2)ctSnow(I).Se=RGB(S,S,255)'雪花略带蓝色，否则在白背景时将看不见EndSubPrivateSubTransWin(hWndAsLong,TransColorAsLong)'将窗口颜色TransColor设置为透明的DimExsTyleAsLongConstWS_EX_LAYERED=&H80000,GWL_ExsTyle=-20ExsTyle=WS_EX_LAYEREDOrGetWindowLong(hWnd,GWL_ExsTyle)SetWindowLonghWnd,GWL_ExsTyle,ExsTyleSetLayeredWindowAttributeshWnd,TransColor,0,1EndSubPrivateSubWinInTop(nWndAsLong,OptionalInTopAsBoolean)'窗口保持最前ConstHWND_NoTopMost=-2'取消在最前ConstHWND_TopMost=-1'最上ConstSWP_NoSize=&H1'wFlags参数ConstSWP_NoMove=&H2ConstSWP_NoZorder=&H4ConstSWP_NoActivate=&H10'不激活窗口ConstSWP_ShowWindow=&H40ConstSWP_HideWindow=&H80DimnInAsLongIfInTopThennIn=HWND_TopMostElsenIn=HWND_NoTopMostSetWindowPosnWnd,nIn,0,0,0,0,SWP_NoSize+SWP_NoMove+SWP_NoActivateEndSub''下面是Form2窗体代码：=====================================''注意：在属性窗口将窗体的BorderStyle属性设置为0，即窗体是无边框窗体PrivateSubForm_DblClick()'双击清除积雪Me.Line(0,0)-(Me.ScaleWidth,Me.ScaleHeight),Me.BackColor,BFEndSub