批处理之家 » VBS原创&转载 » VBS版的模拟黑客帝国数码雨

老刘1号 发表于 2019-4-23 13:53

VBS版的模拟黑客帝国数码雨

本来还想弄个颜色渐变，奈何控制台颜色有限，加之调用API换位置调颜色速度低下，遂放弃
下面的代码先生成Str，再输出，避免了大量重复调用api，基本不会卡顿
[img]http://www.wailian.work/images/2019/04/23/-A-.gif[/img][code]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[/code]需要一个第三方COM，控制台框架，由[url=http://www.bathome.net/space.php?uid=75169]@Nsqs[/url]开发， 在此表示感谢。

523066680 发表于 2019-4-23 15:30

[url=http://img.gzsophy.com/bathome/laoliu200px.gif]4.8M gif[/url]，可能要点时间

[img]http://img.gzsophy.com/bathome/laoliu200px.gif[/img]

老刘1号 发表于 2019-4-23 16:28

[i=s] 本帖最后由 老刘1号 于 2019-4-23 16:56 编辑 [/i]

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=219585&ptid=52635]2#[/url] [i]523066680[/i] [/b]


    啥都不说了，换头像去

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

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

xczxczxcz 发表于 2019-4-23 17:08

留个爪印。:loveliness:

查看完整版本: VBS版的模拟黑客帝国数码雨