Forma 1 Adet Modul ve Timer Ekleyin ve bunun intervalini kar yağması ne zaman başlasın istiyorsanız ona gore ayarlayın
Modul Kısmına
Kod:
Option Explicit Type xParticle X As Integer Y As Integer oldX As Integer oldY As Integer iStopped As Integer End Type Global Const MAXP = 400 Global Const PSIZE = 1 Global Snow(0 To MAXP) As xParticle
Form Kısmına
Kod:
Option Explicit Dim bRUN As Boolean Dim fMouseDown_X As Single Dim fMouseDown_Y As Single Dim bMOUSE_DOWN As Boolean Private Sub Form_Load() Randomize Me.ScaleMode = vbPixels Me.DrawWidth = PSIZE Me.BackColor = vbBlack Dim i As Integer For i = 0 To MAXP Snow(i).X = CInt(Int(Me.ScaleWidth * Rnd)) Snow(i).Y = CInt(Int(Me.ScaleHeight * Rnd)) Next i bRUN = True Timer1.Enabled = True Me.ForeColor = vbWhite End Sub Sub DrawSnow() Dim i As Integer Dim newX As Integer Dim newY As Integer Timer1.Enabled = False Do While bRUN For i = 0 To MAXP Me.PSet (Snow(i).oldX, Snow(i).oldY), vbBlack Me.PSet (Snow(i).X, Snow(i).Y) Next i For i = 0 To MAXP Snow(i).oldX = Snow(i).X Snow(i).oldY = Snow(i).Y newX = Snow(i).X + Int(2 * Rnd) newX = newX - Int(2 * Rnd) If newX < 0 Then newX = 0 If newX >= Me.ScaleWidth Then newX = Me.ScaleWidth - 1 newY = Snow(i).Y + 1 If Me.Point(newX, newY) = vbBlack Then Snow(i).Y = newY Snow(i).X = newX Else If Snow(i).iStopped = 10 Then If Me.Point(Snow(i).X + 1, Snow(i).Y + 1) = vbBlack Then Snow(i).X = Snow(i).X + 1 Snow(i).Y = Snow(i).Y + 1 Snow(i).iStopped = 0 ElseIf Me.Point(Snow(i).X - 1, Snow(i).Y + 1) = vbBlack Then Snow(i).X = Snow(i).X - 1 Snow(i).Y = Snow(i).Y + 1 Snow(i).iStopped = 0 Else newParticle (i) End If Else Snow(i).iStopped = Snow(i).iStopped + 1 End If End If If (Snow(i).Y) >= Me.ScaleHeight Then newParticle (i) End If Next i DoEvents Loop End Sub Sub newParticle(i As Integer) Snow(i).X = CInt(Int(Me.ScaleWidth * Rnd)) Snow(i).Y = 0 Snow(i).oldX = 0 Snow(i).oldY = 0 Snow(i).iStopped = 0 End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.PSet (X, Y) bMOUSE_DOWN = True fMouseDown_X = X fMouseDown_Y = Y End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If bMOUSE_DOWN Then Dim oldDW As Long Dim oldFC As Long oldDW = Me.DrawWidth oldFC = Me.ForeColor Me.DrawWidth = 3 Me.ForeColor = vbRed Me.Line (fMouseDown_X, fMouseDown_Y)-(X, Y) fMouseDown_X = X fMouseDown_Y = Y Me.DrawWidth = oldDW Me.ForeColor = oldFC End If End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) bMOUSE_DOWN = False End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) bRUN = False End Sub Private Sub Timer1_Timer() DrawSnow End Sub
__________________
Forma Kar Yağma Efekti... ( Visual Basic 6 )
Visual Basic0 Mesaj
●27 Görüntüleme
- ReadBull.net
- Programlama ve Yazılım
- Programlama Dilleri
- Visual Basic
- Forma Kar Yağma Efekti... ( Visual Basic 6 )