当前位置：首页>VB 小程序> 让整个屏幕雪花飘飘（改进）58. VB整人小程序：让整个屏幕雪花飘飘（改进）这是我以前写的小程序让整个屏幕雪花飘飘的改进，本程序是一个模拟下雪的小程序：大小不同随风飘荡的雪花从屏幕上方不断落下，飘满整个屏幕。
雪花可在任何窗口上飘荡，包括任务栏、开始菜单、弹出菜单等地方。
本程序与原程序的主要改进之处是：落下的雪花不会消失，会在屏幕底部不断堆积，双击屏幕底部的积雪可使积雪消失。
本程序编译成 exe 文件运行后，只能通过系统“任务管理器”才能终止运行。
程序运行效果截图如下:'' '本程序包含两个窗体，Form1 和 Form2，其中 Form1 是启动窗体。
代码在在 VB6 调试通过：''下面是 Form1 窗体代码：====================================='' 注意：在属性窗口将窗体的 BorderStyle 属性设置为 0，即窗体是无边框窗体'' 在窗体上放置一个控件：Timer1，不必设置任何属性''本人原创，转载请注明文章来源：/100bd/blog/item/fbb5bdd5f0564910a08bb740.html Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPrivate Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongDim ctSnow() As tySnow, ctSnowS As Long, ctSeChange As LongPrivate Type tySnow '定义表示雪花的数据类型X As Single: xV As Single 'x 坐标、水平移动速度Y As Single: yV As Single 'y 坐标、垂直移动速度Se As Long: Size As Single '雪花颜色、大小End TypePrivate Sub Form_Load()ctSnowS = 200 '300 '雪花数量ctSeChange = 30 '雪花颜色的变化范围'最大化窗口。
注意：不要用在属性窗口设置 WindowState 属性的方'式，也不使用 Me.WindowState = 2 代码。
否则，在用户调整任务'栏状态的时候，会造成积雪的位置错位。
Me.WindowState = 0Me.Move 0, 0, Screen.Width, Screen.HeightReDim ctSnow(1 To ctSnowS)Me.Caption = "雪花飘飘"Me.AutoRedraw = True: Me.ScaleMode = 3Me.BackColor = RGB(235 - ctSeChange * 2, 235 - ctSeChange * 2, 255) Call TransWin(Me.hWnd, Me.BackColor) '将窗口背景色设置为透明的Form2.AutoRedraw = True: Form2.ScaleMode = 3Form2.BackColor = Me.BackColorForm2.Move Form1.Left, Form1.Top, Form1.Width, Form1.HeightCall TransWin(Form2.hWnd, Form2.BackColor) '将窗口背景色设置为透明的Form2.ShowTimer1.Enabled = True: Timer1.Interval = 20End SubPrivate Sub Timer1_Timer()Dim I As Long, V As Single, H1 As Single, IsDown As Boolean, Se As LongV = 8 '修改此数字，可改变雪花整体飘荡的速度Randomize '初始化随机发生器WinInTop Me.hWnd, True '使雪花（窗口）显示在最前，包括显示到任务栏上面WinInTop Form2.hWnd, TrueMe.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), Me.BackColor, BF For I = 1 To ctSnowSctSnow(I).X = ctSnow(I).X + ctSnow(I).xV * VctSnow(I).Y = ctSnow(I).Y + ctSnow(I).yV * VIf Rnd * 20 < 1 Then ctSnow(I).xV = Rnd - 0.5 '改变水平移动速度，模拟随风飘荡If ctSnow(I).Size = 0 Or ctSnow(I).Y > Me.ScaleHeight Then Call SnowInit(I) '未初始化，或超出下边界' ctSnow(I).Size = 2 '****调试代码ShowStr Me, I '画一朵雪花Me.Font.Size = ctSnow(I).SizeH1 = Me.TextHeight("*") * 0.5 '半个字符高度If ctSnow(I).X < -H1 Then ctSnow(I).X = Me.ScaleWidth '超出左边界If ctSnow(I).X > Me.ScaleWidth Then ctSnow(I).X = -H1 '超出右边界'最下层积雪位置IsDown = ctSnow(I).Y > Me.ScaleHeight - H1If IsDown Then ctSnow(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) If Se > -1 And Se <> Form2.BackColor Then IsDown = True'已落到最下面，在 Form2 的相同位置绘制积雪If IsDown ThenShowStr Form2, ICall SnowInit(I)If ctSnow(I).Y > Me.ScaleHeight * 0.9 ThenForm2.Font.Size = 12Form2.CurrentX = (Me.ScaleWidth - 8 * Me.TextHeight("12")) * 0.5Form2.CurrentY = Me.ScaleHeight * 0.92Form2.ForeColor = RGB(0, 0, 255)Form2.Print "双击此处消除积雪"End IfEnd IfNextEnd SubPrivate Sub ShowStr(Kj, I As Long)'画一朵雪花Dim H1 As SingleKj.Font.Size = ctSnow(I).SizeKj.CurrentX = ctSnow(I).XKj.CurrentY = ctSnow(I).YKj.ForeColor = ctSnow(I).SeIf ctSnow(I).Size > 4.2 ThenKj.Print "*"ElseIf ctSnow(I).Size > 3 Then Kj.DrawWidth = 2 Else Kj.DrawWidth = 1H1 = Kj.TextHeight("*") * 0.5Kj.PSet (ctSnow(I).X + H1 * 0.5, ctSnow(I).Y + H1 - 1)End IfEnd SubPrivate Sub SnowInit(I As Long)'初始化一朵雪花Dim S As SinglectSnow(I).X = Rnd * Me.ScaleWidthctSnow(I).xV = Rnd - 0.5ctSnow(I).yV = Rnd * 0.5 + 0.1S = 2 + Rnd * 9 '字体最大 11 号If ctSnow(I).Size = 0 ThenctSnow(I).Y = Rnd * Me.ScaleHeightElseMe.Font.Size = SctSnow(I).Y = -Me.TextHeight("*")End IfctSnow(I).Size = SS = 235 - ctSeChange * 2 + Int(Rnd * ctSeChange * 2)ctSnow(I).Se = RGB(S, S, 255) '雪花略带蓝色，否则在白背景时将看不见End SubPrivate Sub TransWin(hWnd As Long, TransColor As Long)'将窗口颜色 TransColor 设置为透明的Dim ExsTyle As LongConst WS_EX_LAYERED = &H80000, GWL_ExsTyle = -20ExsTyle = WS_EX_LAYERED Or GetWindowLong(hWnd, GWL_ExsTyle)SetWindowLong hWnd, GWL_ExsTyle, ExsTyleSetLayeredWindowAttributes hWnd, TransColor, 0, 1End SubPrivate Sub WinInTop(nWnd As Long, Optional InTop As Boolean) '窗口保持最前Const HWND_NoTopMost = -2 '取消在最前Const HWND_TopMost = -1 '最上Const SWP_NoSize = &H1 'wFlags 参数Const SWP_NoMove = &H2Const SWP_NoZorder = &H4Const SWP_NoActivate = &H10 '不激活窗口Const SWP_ShowWindow = &H40Const SWP_HideWindow = &H80Dim nIn As LongIf InTop Then nIn = HWND_TopMost Else nIn = HWND_NoTopMostSetWindowPos nWnd, nIn, 0, 0, 0, 0, SWP_NoSize + SWP_NoMove + SWP_NoActivateEnd Sub''下面是Form2 窗体代码：====================================='' 注意：在属性窗口将窗体的BorderStyle 属性设置为0，即窗体是无边框窗体Private Sub Form_DblClick()'双击清除积雪Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), Me.BackColor, BFEnd Sub。