Membuat Animasi Picture

Membuat aplikasi seringkali kita ingin agar aplikasi kita kelihatan menarik misalnya about me, loading form atau halaman pembuka. berikut saya berikan contoh Membuat Animasi Picture VB 6 dan bisa dikembangkan sesuai kebutuhan kita.
Contoh tampilan latihan membuat animasi picture seperti di bawah ini :

Option ExplicitPrivate Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)Dim flipped As Integer  ' bit field
Private Sub Form_Load()    Show    DoEvents    cboDissolve.ListIndex = 0End Sub
Private Sub cboZoom_Click()    cmdShow.Value = TrueEnd Sub
Private Sub chkTile_Click()    cmdShow.Value = TrueEnd Sub
Private Sub cboDissolve_Click()    fraZoom.Enabled = (cboDissolve.ListIndex = 0)    cmdHorizontal.Enabled = (cboDissolve.ListIndex = 0)    cmdVertical.Enabled = (cboDissolve.ListIndex = 0)    cmdBoth.Enabled = (cboDissolve.ListIndex = 0)    cmdShow.Value = TrueEnd Sub
Private Sub cmdShow_Click()    If cboDissolve.ListIndex = 0 Then        ShowImage    Else        DissolveImage    End If    flipped = 0End Sub
Sub ShowImage()    Dim destWidth As Single, destHeight As Single    Dim destX As Single, destY As Single    Dim stepX As Single, stepY As Single        Select Case cboZoom.ListIndex        Case cboZoom.ListCount - 4            destWidth = picDest.ScaleWidth            destHeight = picSource.ScaleHeight * (destWidth / picSource.ScaleWidth)        Case cboZoom.ListCount - 3            destHeight = picDest.ScaleHeight            destWidth = picSource.ScaleWidth * (destHeight / picSource.ScaleWidth)        Case cboZoom.ListCount - 2            destWidth = picDest.ScaleWidth            destHeight = picDest.ScaleHeight            If destWidth / picSource.ScaleWidth < destHeight / picDest.ScaleHeight Then                destHeight = picSource.ScaleHeight * (destWidth / picSource.ScaleWidth)            Else                destWidth = picSource.ScaleWidth * (destHeight / picSource.ScaleWidth)            End If        Case cboZoom.ListCount - 1            destWidth = picDest.ScaleWidth            destHeight = picDest.ScaleHeight        Case Else            On Error Resume Next            destWidth = picSource.ScaleWidth * Val(cboZoom) / 100            destHeight = picSource.ScaleHeight * Val(cboZoom) / 100            If Err Then Exit Sub    End Select        picDest.Cls        If chkTile.Value = vbChecked Then        For destX = 0 To picDest.ScaleWidth Step destWidth            For destY = 0 To picDest.ScaleHeight Step destHeight                picDest.PaintPicture picSource.Picture, destX, destY, destWidth, destHeight            Next        Next    Else        picDest.PaintPicture picSource.Picture, 0, 0, destWidth, destHeight    End IfEnd Sub
Sub DissolveImage()    Dim srcWidth As Single, srcHeight As Single    Dim srcX As Single, srcY As Single    Dim destWidth As Single, destHeight As Single    Dim destX As Single, destY As Single    Dim stepX As Single, stepY As Single    Dim i As Integer        Const DISSOLVE_STEPS = 20        srcWidth = picSource.ScaleWidth    srcHeight = picSource.ScaleHeight            stepX = srcWidth / DISSOLVE_STEPS    stepY = srcHeight / DISSOLVE_STEPS        picDest.Cls        Select Case cboDissolve.ListIndex        Case 1            srcX = srcWidth            For i = 1 To DISSOLVE_STEPS                srcX = srcX - stepX                picDest.PaintPicture picSource.Picture, 0, 0, , , srcX, 0                RefreshAndDelay            Next        Case 2            destX = srcWidth            For i = 1 To DISSOLVE_STEPS                destX = destX - stepX                picDest.PaintPicture picSource.Picture, destX, 0, srcWidth - destX, , , , srcWidth - destX                RefreshAndDelay            Next        Case 3            srcY = srcHeight            For i = 1 To DISSOLVE_STEPS                srcY = srcY - stepY                picDest.PaintPicture picSource.Picture, 0, 0, , , 0, srcY                RefreshAndDelay            Next        Case 4            destY = srcHeight            For i = 1 To DISSOLVE_STEPS                destY = destY - stepY                picDest.PaintPicture picSource.Picture, 0, destY, , , , , , srcHeight - destY                RefreshAndDelay            Next                    Case 5            destWidth = 0            For i = 1 To DISSOLVE_STEPS                destWidth = destWidth + stepX                picDest.PaintPicture picSource.Picture, 0, 0, , , 0, 0, destWidth                RefreshAndDelay            Next        Case 6            destX = srcWidth            For i = 1 To DISSOLVE_STEPS                destX = destX - stepX                picDest.PaintPicture picSource.Picture, destX, 0, , , destX, 0, srcWidth - destX                RefreshAndDelay            Next        Case 7            destHeight = 0            For i = 1 To DISSOLVE_STEPS                destHeight = destHeight + stepY                picDest.PaintPicture picSource.Picture, 0, 0, , , 0, 0, , destHeight                RefreshAndDelay            Next        Case 8            destY = srcHeight            For i = 1 To DISSOLVE_STEPS                destY = destY - stepY                picDest.PaintPicture picSource.Picture, 0, destY, , , 0, destY, , srcHeight - destY                RefreshAndDelay            Next        Case 9            destX = srcWidth / 2            destY = srcHeight / 2            srcWidth = 0            srcHeight = 0            For i = 1 To DISSOLVE_STEPS                destX = destX - stepX / 2                destY = destY - stepY / 2                srcWidth = srcWidth + stepX                srcHeight = srcHeight + stepY                picDest.PaintPicture picSource.Picture, destX, destY, , , destX, destY, srcWidth, srcHeight                RefreshAndDelay            Next        Case 10            Dim xy(DISSOLVE_STEPS * DISSOLVE_STEPS, 1) As ShiftConstants            Dim kx As Integer, ky As Integer, ndx As Integer            destX = 0            For kx = 1 To DISSOLVE_STEPS                destY = 0                For ky = 1 To DISSOLVE_STEPS                    i = i + 1                    xy(i, 0) = destX                    xy(i, 1) = destY                    destY = destY + stepY                Next                destX = destX + stepX            Next            For ndx = UBound(xy) To 1 Step -1                i = Int(Rnd * ndx + 1)                destX = xy(i, 0)                destY = xy(i, 1)                picDest.PaintPicture picSource.Picture, destX, destY, , , destX, destY, stepX, stepY                xy(i, 0) = xy(ndx, 0)                xy(i, 1) = xy(ndx, 1)            Next    End Select
End Sub
Private Sub cmdHorizontal_Click()    flipped = flipped Xor 1    ShowFlippedImageEnd Sub
Private Sub cmdVertical_Click()    flipped = flipped Xor 2    ShowFlippedImageEnd Sub
Private Sub cmdBoth_Click()    flipped = flipped Xor 3    ShowFlippedImageEnd Sub
Sub ShowFlippedImage()    picDest.Cls    Select Case flipped        Case 0            picDest.PaintPicture picSource.Picture, 0, 0        Case 1            picDest.PaintPicture picSource.Picture, picSource.ScaleWidth, 0, -picSource.ScaleWidth        Case 2            picDest.PaintPicture picSource.Picture, 0, picSource.ScaleHeight, , -picSource.ScaleHeight        Case 3  picDest.PaintPicture picSource.Picture, picSource.ScaleWidth, picSource.ScaleHeight, -picSource.ScaleWidth, -picSource.ScaleHeight    End SelectEnd Sub
Sub RefreshAndDelay()    Sleep 50End Sub

Kode diatas hanya sederhana, saya dapat dari internet melalui Om Googleee. dan telah membantu saya membuat aplikasi sederhana.

Source Code