[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[原创] VBS版的模拟黑客帝国数码雨

本来还想弄个颜色渐变,奈何控制台颜色有限,加之调用API换位置调颜色速度低下,遂放弃
下面的代码先生成Str,再输出,避免了大量重复调用api,基本不会卡顿
  1. Rem Code BY 老刘
  2. Rem 转载请注明出处
  3. Const CharMap = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
  4. Dim Console
  5. Set Console = CreateObject("Vbscript.Console")
  6. Console.Title Chr(&HA1BE)&Chr(&HC0CF)&Chr(&HC1F5)&Chr(&HB1E0)&Chr(&HD0B4)&Chr(&HA1BF)&Chr(&HC4A3)&Chr(&HC4E2)&Chr(&HBADA)&Chr(&HBFCD)&Chr(&HB5DB)&Chr(&HB9FA)&Chr(&HCAFD)&Chr(&HC2EB)&Chr(&HD3EA)
  7. Width = Console.ViewWidth - 1
  8. Height = Console.ViewHeight - 2
  9. SingleRowMaxRaindrop = 3
  10. Console.CursorVisable = False
  11. Console.SetViewSize Width + 2,Height + 1
  12. Console.ForeColor = 10
  13. Dim NowDown(),y(),Length()
  14. ReDim NowDown(Width - 1),y(Height - 1),SpaceArray(Width - 1),Length(Width - 1)
  15. For i = 1 To Width
  16. SpaceArray(i - 1) = " "
  17. Next
  18. For i = 1 To Height
  19. y(i-1)=SpaceArray
  20. Next
  21. 'For i = 1 To Width
  22. ' NowDown(i - 1) = Empty
  23. 'Next
  24. 'For i = 1 To Width
  25. ' Length(i - 1) = Fix(Rnd * (Height / 3) * 2) + Fix(Height / 4)
  26. 'Next
  27. While True
  28. For i = 0 To UBound(NowDown)
  29. If NowDown(i) = Empty Then '新增雨滴
  30. NowDown(i) = - Fix(Rnd * Height)
  31. Length(i) = Fix(Rnd * (Height / 3) * 2) + Fix(Height / 4)
  32. End If
  33. If NowDown(i) < Height And NowDown(i) >= 0 Then '画雨滴
  34. y(NowDown(i))(i) = Mid(CharMap,Fix(Rnd * Len(CharMap)) + 1,1)
  35. End If
  36. If NowDown(i) - Length(i) >= 0 And NowDown(i) - Length(i) < Height Then '擦除雨滴
  37. y(NowDown(i) - Length(i))(i) = " "
  38. End If
  39. If NowDown(i) - Length(i) + 1 = Height Then '判断是否下落完成
  40. NowDown(i) = Empty
  41. Else
  42. NowDown(i) = NowDown(i) + 1
  43. End If
  44. Next
  45. On Error Resume Next
  46. Console.MoveCursor 0,0
  47. If Err.Number <> 0 Then WScript.Quit
  48. On Error Goto 0
  49. Console.WriteText GetStr(y)
  50. 'WScript.Echo String(UBound(y)+1,"-")
  51. 'WScript.Echo GetStr(y)
  52. WScript.Sleep 10
  53. Wend
  54. Function GetStr(Arr)
  55. Dim Str
  56. Str = ""
  57. For i = 0 To UBound(Arr)
  58. Str = Str & Join(Arr(i),"") & vbNewLine
  59. Next
  60. GetStr = Str
  61. End Function
复制代码
需要一个第三方COM,控制台框架,由@Nsqs开发, 在此表示感谢。
2

评分人数

留个爪印。

TOP

本帖最后由 老刘1号 于 2019-4-23 16:56 编辑

回复 2# 523066680


    啥都不说了,换头像去

——————————————————————————————
论坛限制1M可还行……
QQ限制40帧还行……

——————————————————————————————
算了我还是收藏吧,基本没有什么平台允许4m+的动态头像。可惜了……

TOP

4.8M gif,可能要点时间

3

评分人数

TOP

返回列表