vb下雪的代码?

vb下雪的代码?,第1张

全屏幕竖银下雪的VB代码,单击鼠标结改胡束下雪代核纤拦码如下,只需把它复制到form中即可:Dim Snow(1000, 2), Amounty As IntegerPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

Unload Me

End SubPrivate Sub Form_Load()

Form1.BackColor = vbBlack

Form1.BorderStyle = 0

Form1.WindowState = 2

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 form1_load(省行信败陵略)

Dim i As Integer

For i=0 To 99

Randomize()

s(i)=New snowflakes(Rnd()*Me.width,Rnd()*Me.Height)

Next

End Sub

Private sub timer1_tick(省略)

Me.Refresh()

pen1=New pen(color.white,5)

g=Me.CreateGraphics

For i=0 to 99

g.DrawEllipse(pen1,s(i).x,s(i).y,1,1)

s(i).down(10)

If s(i).x>档枯轮=Me.width Then

s(i).x=Rnd()*20

End If

If s(i).y>=Me.Height Then

s(i).y=Rnd()*10

End If

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

EndSub


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/12332903.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-24
下一篇 2023-05-24

发表评论

登录后才能评论

评论列表(0条)

保存