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

老刘1号

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

Rem Code BY 老刘
Rem 转载请注明出处

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开发， 在此表示感谢。

xczxczxcz

留个爪印。

老刘1号

回复 2# 523066680


    啥都不说了，换头像去

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

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

523066680

4.8M gif，可能要点时间