[VBS]简易黑客帝国数码雨特效

老刘

简易代码雨特效，效果一般，大佬见笑，
本来还想弄个颜色渐变，奈何控制台颜色有限，加之调用API换位置调颜色速度低下，遂放弃。
下面的代码先生成Str，再输出，避免了大量重复调用api，基本不会卡顿。
效果图：

[Visual Basic] 纯文本查看 复制代码

Rem Code BY 老刘
Rem 转载请注明出处
Rem 控制台框架由Nsqs开发，在此表示感谢！

Const CharMap = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
Dim Console
Set Console = CreateObject("Vbscript.Console")
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)
Width = Console.ViewWidth - 1
Height = Console.ViewHeight - 2
SingleRowMaxRaindrop = 3
Console.CursorVisable = False
Console.SetViewSize Width + 2,Height + 1
Console.ForeColor = 10
Dim NowDown(),y(),Length()
ReDim NowDown(Width - 1),y(Height - 1),SpaceArray(Width - 1),Length(Width - 1)

For i = 1 To Width
	SpaceArray(i - 1) = " "
Next

For i = 1 To Height
	y(i-1)=SpaceArray
Next

'For i = 1 To Width 
'	NowDown(i - 1) = Empty
'Next

'For i = 1 To Width 
'	Length(i - 1) = Fix(Rnd * (Height / 3) * 2) + Fix(Height / 4)
'Next

While True
	For i = 0 To UBound(NowDown)
		If NowDown(i) = Empty Then	'新增雨滴
			NowDown(i) = - Fix(Rnd * Height)
			Length(i) = Fix(Rnd * (Height / 3) * 2) + Fix(Height / 4)
		End If
		If NowDown(i) < Height And NowDown(i) >= 0 Then	'画雨滴
			y(NowDown(i))(i) = Mid(CharMap,Fix(Rnd * Len(CharMap)) + 1,1)
		End If
		If NowDown(i) - Length(i) >= 0 And NowDown(i) - Length(i) < Height Then	'擦除雨滴
			y(NowDown(i) - Length(i))(i) = " "
		End If
		If NowDown(i) - Length(i) + 1 = Height Then	'判断是否下落完成
			NowDown(i) = Empty
		Else
			NowDown(i) = NowDown(i) + 1
		End If
	Next
	On Error Resume Next
	Console.MoveCursor 0,0
	If Err.Number <> 0 Then WScript.Quit
	On Error Goto 0
	Console.WriteText GetStr(y)
	'WScript.Echo String(UBound(y)+1,"-")
	'WScript.Echo GetStr(y)
	WScript.Sleep 10
Wend

Function GetStr(Arr)
	Dim Str
	Str = ""
	For i = 0 To UBound(Arr)
		Str = Str & Join(Arr(i),"") & vbNewLine
	Next
	GetStr = Str
End Function

需要一个第三方COM（控制台框架），由@Nsqs开发，在此表示感谢！
Console.7z (16.76 KB, 下载次数: 57)

2019-4-23 14:57 上传

点击文件名下载附件

熊猫

真好玩 下载试试

yx2011

高手  支持~~~~~~~~~~~~

缘下有我

黑色背景绿字母。