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