VB模拟下雨

窗体代码如下：

Option Explicit

'视觉上看到的雨，可能是这样的：

'在近似位置反复看到雨丝，

'而不是完全杂乱无章，也不是看到同一个雨丝下落的全过程

'雨的颜色可能是浅灰色混合了背景色

'基于以上认识，用vb模拟下雨。

Dim tmItv As Long '定时器间隔毫秒，＞0

Dim howMany As Integer '雨丝数量，≥0

Dim reNew As Single '每帧更新率，0到1的浮点数，比如0.15就是更新15%

Dim alP As Single '像素混合系数，0到1的浮点数，值越大、雨的颜色越接近背景色

Dim Swing As Integer '雨丝在两个相近位置“摆动”的幅度，≥0

Dim leNgth As Integer '雨丝的长度，＞0

Dim angLe As Single '雨丝下落的角度，0到180

Dim preciSion As Single '位移的精度，0到1的浮点数，越大越精确

Dim angleHu As Single '雨丝下落的角度转换为弧度

Const PI = 3.14159265358979

Dim inputVar As String '输入的一组参数

Private Type Rain

  Rx As Long '雨丝line上端点的坐标

  Ry As Long

End Type

Dim rainArr() As Rain

Dim I As Integer

Private Sub Form_Load()

  

  '设计时给窗体指定了一个picture作为背景图片。只有一个定时器控件

  Form1.Caption = "It's raining outside...Click to set"

  '点击窗体，设置各参数

  Form1.ScaleMode = 1 '缇

  Form1.AutoRedraw = True

    

  tmItv = 200

  howMany = 300

  reNew = 0.2

  alP = 0.6

  Swing = 100

  leNgth = 250

  angLe = 60: angleHu = angLe * PI / 180

  preciSion = 0.8

  

  inputVar = CStr(tmItv) & "," & CStr(howMany) & "," & Format(CStr(reNew), "0.00") & "," & Format(CStr(alP), "0.00") & "," & CStr(Swing) & "," & CStr(leNgth) & "," & Format(CStr(angLe), "0.00") & "," & Format(CStr(preciSion), "0.00")

  

  Timer1.Interval = tmItv

  Timer1.Enabled = True

  Form1.ForeColor = RGB(180, 200, 200) '假定雨本身的颜色

  DrawWidth = 1

  ReDim rainArr(0 To howMany)

  Randomize

  For I = 0 To howMany

    rainArr(I).Rx = Int(Rnd * Form1.ScaleWidth)

    rainArr(I).Ry = Int(Rnd * Form1.ScaleHeight)

  Next 'I

End Sub

Private Sub Form_Click() '单击窗体设置参数

  Dim InputvarTemp As String

  InputvarTemp = InputBox(prompt:="请对现有各参数进行修改，依次是：" & vbCrLf & vbCrLf & "定时器、雨丝数量、每帧更新率、像素混合系数、幅度、长度、角度、精度，" & vbCrLf & vbCrLf & "用西文逗号分隔", Title:="设置下雨参数", Default:=inputVar)

  

  If InputvarTemp <> "" Then

  '不检查输入值是否符合值域。如果设置不当、可能引起运行错误

    tmItv = Val(Split(InputvarTemp, ",")(0))

    howMany = Val(Split(InputvarTemp, ",")(1))

    reNew = Val(Split(InputvarTemp, ",")(2))

    alP = Val(Split(InputvarTemp, ",")(3))

    Swing = Val(Split(InputvarTemp, ",")(4))

    leNgth = Val(Split(InputvarTemp, ",")(5))

    angLe = Val(Split(InputvarTemp, ",")(6)): angleHu = angLe * PI / 180

    preciSion = Val(Split(InputvarTemp, ",")(7))

    

    Timer1.Interval = tmItv

    ReDim Preserve rainArr(0 To howMany)

    '如果增加了雨丝数量，默认坐标是0,0

    inputVar = CStr(tmItv) & "," & CStr(howMany) & "," & Format(CStr(reNew), "0.00") & "," & Format(CStr(alP), "0.00") & "," & CStr(Swing) & "," & CStr(leNgth) & "," & Format(CStr(angLe), "0.00") & "," & Format(CStr(preciSion), "0.00")

  End If

End Sub

Private Sub Timer1_Timer()

  Static N As Integer

  N = (N Mod 2) + 1

 

  Cls

  For I = 0 To howMany

    Randomize

    If Rnd < reNew Or (rainArr(I).Rx = 0 And rainArr(I).Ry = 0) Then

    '以指定的更新率随机‘消失’，在新位置出现

    '增加的雨丝数量也在随机位置出现，而不是窗体左上角

      rainArr(I).Rx = Int(Rnd * Form1.ScaleWidth)

      rainArr(I).Ry = Int(Rnd * Form1.ScaleHeight)

    Else

      '雨丝上端点平移：来回反复，四种方向，移动距离根据精度有微调

      ' xy

      '0++

      '1+-

      '2-+

      '3--

      rainArr(I).Rx = rainArr(I).Rx + Int((Swing * (2 - preciSion) - Swing * preciSion + 1) * Rnd + Swing * preciSion) * IIf(N = 1, 1, -1) * IIf((I Mod 4) < 2, 1, -1)

      rainArr(I).Ry = rainArr(I).Ry + Int((Swing * (2 - preciSion) - Swing * preciSion + 1) * Rnd + Swing * preciSion) * IIf(N = 1, 1, -1) * IIf(((I Mod 4) Mod 2) = 0, 1, -1)

    End If

   

    If Form1.Point(rainArr(I).Rx, rainArr(I).Ry) <> -1 Then

      Dim rmoD As Byte, gmoD As Byte, bmoD As Byte

      Call getRgbMod(Form1.Point(rainArr(I).Rx, rainArr(I).Ry), rmoD, gmoD, bmoD)

    

      '''混合颜色的伪代码

      '''

      '''dd = 颜色1

      '''ss = 颜色2

      '''aa=混合度(0-1的浮点数)

      '''

      '''dr = GetRValue(dd)

      '''dg = GetGValue(dd)

      '''db = GetBValue(dd)

      '''

      '''sr = GetRValue(ss)

      '''sg = GetGValue(ss)

      '''sb = GetBValue(ss)

      '''

      '''nr = dr * aa + sr * (1 - aa)

      '''ng = dg * aa + sg * (1 - aa)

      '''nb = db * aa + sb * (1 - aa)

      '''

      '''合成后的颜色 = RGB(nr, ng, nb)

    

      Form1.ForeColor = RGB(rmoD * alP + 180 * (1 - alP), gmoD * alP + 200 * (1 - alP), bmoD * alP + 200 * (1 - alP))

    Else

      Form1.ForeColor = RGB(180, 200, 200)

    End If

  

    Line (rainArr(I).Rx, rainArr(I).Ry)-(rainArr(I).Rx + Int((leNgth * Cos(angleHu) * (2 - preciSion) - leNgth * Cos(angleHu) * preciSion + 1) * Rnd + leNgth * Cos(angleHu) * preciSion), rainArr(I).Ry + Int((leNgth * Sin(angleHu) * (2 - preciSion) - leNgth
* Sin(angleHu) * preciSion + 1) * Rnd + leNgth * Sin(angleHu) * preciSion))

    'line方法画雨丝，长度和角度根据精度有微调（即调整下端点的坐标）

  

  Next 'I

End Sub

Sub getRgbMod(ByVal ColoR As Long, Optional ByRef GetR As Byte, _

  Optional ByRef GetG As Byte, Optional ByRef GetB As Byte)

  '分解r、g、b

  GetR = ColoR Mod &H100 '等于十进制256

  GetG = (ColoR \ &H100) Mod &H100 '等于十进制256

  GetB = (ColoR \ &H10000) Mod &H100 '等于十进制65536 256

End Sub