[ VB 6.0 ] membuat animasi form

Assalamualaikum..............


Contoh 1:
Private Sub Form_Unload(Cancel As Integer)
Me.BackColor = vbWhite ' warna belakang putih
WindowState = 2 ' maximized-kan
DrawWidth = 4 '/ ketebalan
For i = 1 To 16000

Bawah = Bawah + 1
Kanan = Kanan + 1
PSet (Rnd * Kanan, Rnd * Bawah), QBColor(Rnd * 15)
Next i
End Sub


Contoh 2:
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
cepat = 150
While Left + Width < Screen.Width
DoEvents
Left = Left + cepat
Wend
While Top - Height < Screen.Height
DoEvents
Top = Top + cepat
Wend
Hide
End Sub

Contoh 3:
Private Sub Timer1_Timer()
Dim LingkaranX, LingkaranY, Radius
ScaleMode = 3
LingkaranX = ScaleWidth / 2
LingkaranY = ScaleHeight / 2
For Radius = 0 To 100
Circle (LingkaranX + Radius / 2, LingkaranY), Radius, RGB(Rnd * 215, Rnd * 55, Rnd * 15)
Next Radius
End Sub


Contoh 4:
Private Sub Form_Load()
Me.AutoRedraw = True
BackColor = 0
For i = 1 To 500
CurrentX = i * 100
CurrentY = i * 100
h = h & i
ForeColor = i * 10000
Print h
Next i
End Sub

Contoh 5:
Private Sub Form_Load()
Me.AutoRedraw = True
Me.DrawWidth = 10
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Form_MouseMove 1, 0, X, Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Caption = "PosisiX=" & X & " - " & "PosisiY=" & Y
If Button = 1 Then
PSet (X, Y), vbBlue
End If
End Sub

Contoh 6:
Private Sub Tutup(FrmObj As Form)
Dim Wid As Long, Heg As Long
With FrmObj
Wid = .Width
Heg = .Height
While Not .Width < 1000 Or .Height < 1000
.Move .Left + 50, .Top + 50, .Width - 100, .Height - 100
DoEvents
If .Top > Screen.Height Or .Left > Screen.Width Then
End
End If
Wend
End With
End Sub

contoh 7:
Private Sub Form_Click()
Tutup Me
End Sub

Public Sub Animation()
Dim i As Long
Dim J As Long
i = Me.ScaleHeight
J = Me.ScaleWidth


While Not i = 0
Me.Height = Me.Height - 25
i = i - 1
Wend


While Not J = 0
Me.Width = Me.Width - 25
J = J - 1
Wend

End Sub


Private Sub Form_Unload(Cancel As Integer)
Animation
End Sub

Posted in: Visual Basic