百度空间 | 百度首页 
 
查看文章
 
vb 屏幕飘雪
2008-03-14 14:13

写了小半天 呵呵``
你看看好么? "小强VB"

Dim Snow(1000, 2), Amounty As Integer
Private Sub Form_Load()
Form1.Show
DoEvents
Randomize
Amounty = 325
For J = 1 To Amounty
Snow(J, 0) = Int(Rnd * Form1.Width)
Snow(J, 1) = Int(Rnd * Form1.Height)
Snow(J, 2) = 10 + (Rnd * 20)
Next J
Do While Not (DoEvents = 0)
For LS = 1 To 10
For I = 1 To Amounty
OldX = Snow(I, 0): OldY = Snow(I, 1)
Snow(I, 1) = Snow(I, 1) + Snow(I, 2)
If Snow(I, 1) > Form1.Height Then
Snow(I, 1) = 0: Snow(I, 2) = 5 + (Rnd * 30)
Snow(I, 0) = Int(Rnd * Form1.Width)
OldX = 0: OldY = 0
End If
Coloury = 8 * (Snow(I, 2) - 10): Coloury = 60 + Coloury
PSet (OldX, OldY), QBColor(0)
PSet (Snow(I, 0), Snow(I, 1)), RGB(Coloury, Coloury, Coloury)
Next I
Next LS
Loop
End
End Sub
编写窗体的鼠标按下代码:
Private Sub Form_MouseDown(Button As Integer,Shift As Integer, X As Single, Y As Single)
unload me
End Sub

Option Explicit

'新建一个窗体,将其 ControlBox 属性设为 False

Dim Snow(1000, 2), Amounty As Integer

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 27 Then '按下 [Esc] 按钮
Unload Me
End If
End Sub

Private Sub Form_Load()
WindowState = vbMaximized
ScaleMode = vbTwips
BackColor = vbBlack
BorderStyle = 0
Caption = ""
Call Runing
End Sub

Private Sub Runing()
Dim i As Integer, j As Integer, k As Integer, n As Integer, m As Single
Dim oldX As Integer, oldY As Integer, Coloury As Integer, bgcolor As Long
Show
DoEvents '转让控制权,以便让操作系统处理其它的事件。
Randomize: Amounty = 1000
For j = 0 To Amounty
Snow(j, 0) = Int(Rnd * ScaleWidth)
Snow(j, 1) = Int(Rnd * ScaleHeight)
Snow(j, 2) = 10 + (Rnd * 20)
Next j

Do While Not (DoEvents = 0)
k = Rnd * 2 - 1 '方向
n = Rnd * 30 + 5 '同一方向吹的时间
For j = 1 To n
m = Rnd * 2.5 '风力
For i = 0 To Amounty
oldX = Snow(i, 0)
oldY = Snow(i, 1)
Snow(i, 0) = (Snow(i, 0) + (Snow(i, 2) * k * m) + ScaleWidth) Mod ScaleWidth '受风的影响
Snow(i, 1) = Snow(i, 1) + Snow(i, 2)
Coloury = 64 + 9 * (Snow(i, 2) - 10)
bgcolor = RGB(Coloury, Coloury, Coloury)
If Snow(i, 1) >= ScaleHeight - 15 Then '到了最下边
Call ReStart(i)
Call DrawSnow(0, 0, i, bgcolor)


Else
If Point(Snow(i, 0), Snow(i, 1)) >= 4210752 _
And Point(Snow(i, 0), Snow(i, 1) + 15) >= 4210752 Then '或者下面有积雪
Snow(i, 1) = Snow(i, 1) - 15
Call DrawSnow(oldX, oldY, i, bgcolor)
Call ReStart(i)
Else
Call DrawSnow(oldX, oldY, i, bgcolor) '继续向下飘
End If
End If
Next i
Next j
Loop
End
End Sub

Private Sub ReStart(ByVal Index As Integer)
Snow(Index, 1) = 0
Snow(Index, 2) = 10 + (Rnd * 20)
Snow(Index, 0) = Int(Rnd * ScaleWidth)
End Sub

Private Sub DrawSnow(ByVal oldX As Single, ByVal oldY As Single, _
ByVal Index As Integer, ByVal bgcolor As Long)
If oldX + oldY > 0 Then PSet (oldX, oldY), QBColor(0) '将对象上的点设置为指定颜色。
PSet (Snow(Index, 0), Snow(Index, 1)), bgcolor
End Sub

这个... 你注意看 CPU的使用频率
Do...Loop 与 For...Next 要看场合应用.

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bshow As Long) As Long
Dim Snow(1000, 2), snowpcs&, x&, j&, i&, oldx&, oldy&, colorno&, oldwidth&, oldheight&, newtop&, ratio!
Dim appdisk$, fname$, picno%, UD As String
Private Sub Form_Load()
If App.PrevInstance = True Then End
'x = ShowCursor(False) '隐藏鼠标,测试时最好别用
Me.BorderStyle = 0: Me.Caption = ""
Me.BackColor = QBColor(0)
Me.Width = Screen.Width: Me.Height = Screen.Height
Me.Move 0, 0
Randomize
snowpcs = 200
For j = 1 To snowpcs
Snow(j, 0) = Int(Rnd * Me.Width)
Snow(j, 1) = Int(Rnd * Me.Height)
Snow(j, 2) = 10 + (Rnd * 20)
Next j
Timer1.Enabled = True
Timer1.Interval = 10
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
x = ShowCursor(True)
End
End Sub

Private Sub Timer1_Timer()
For i = 1 To snowpcs
oldx = Snow(i, 0): oldy = Snow(i, 1)
Snow(i, 1) = Snow(i, 1) + Snow(i, 2)
If Snow(i, 1) > Me.Height Then
Snow(i, 1) = 0: Snow(i, 2) = 5 + (Rnd * 200)
Snow(i, 0) = Int(Rnd * Me.Width)
oldx = 0: oldy = 0
End If
colorno = 8 * (Snow(i, 2) - 10): colorno = 60 + colorno
PSet (oldx, oldy), QBColor(0)
PSet (Snow(i, 0), Snow(i, 1)), RGB(colorno, colorno, colorno)
DoEvents
Next i
End Sub
你自己看效果!!!


类别:Vb | 添加到搜藏 | 浏览() | 评论 (0)
 
最近读者:
 
网友评论:
发表评论:
姓 名:
网址或邮箱: (选填)
内 容:
验证码: 请点击后输入四位验证码,字母不区分大小写
      

     

©2009 Baidu