Animasi Slide Scrolling Image

Animasi Slide Scrolling Image kali ini akan admin bahas, yaitu animasi gambar slide seolah-olah dalam animasi ini terlihat berjalan dengan bergantinya image secara slide, biasanya banyak ditemui pada game-game, seolah-olah sewaktu menjalankan karakter game berada disuatu tempat dan berjalan, tanpa kita sadari background pada game tersebut pada umumnya hanya Animasi Slide Scrolling Image.

Komponen yang akan digunakan pun sangat standar hanya saja ada beberapa setting yang berbeda khususnya pada Setting Propoerties Form, pada jendela form properties sebelah kanan, kita cari AutoRedraw = True dan ScaleMode = 1 - Twip. Kemudian tambahkan juga beberapa komponen standar pada form 

Setting Komponen properties seperti dibawah ini

Copykan scipt variabel dan function pada Form pada Prosedur (General) dan (Declaration)

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Const IMAGE_BITMAP As Long = 0
Const LR_LOADFROMFILE As Long = &H10
Const LR_CREATEDIBSECTION As Long = &H2000
'****************************************
Dim BackDC As Long
Const BackHeight As Long = 250
Const BackLength As Long = 750
Const ScrollWidth As Long = 250

Public Function GenerateDC(FileName As String) As Long
Dim DC As Long
Dim hBitmap As Long
DC = CreateCompatibleDC(0)
If DC < 1 Then
    GenerateDC = 0
    Exit Function
End If
hBitmap = LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)

If hBitmap = 0 Then
    DeleteDC DC
    GenerateDC = 0
    Exit Function
End If
SelectObject DC, hBitmap
GenerateDC = DC
DeleteObject hBitmap
End Function
Private Function DeleteGeneratedDC(DC As Long) As Long
If DC > 0 Then
    DeleteGeneratedDC = DeleteDC(DC)
Else
    DeleteGeneratedDC = 0
End If
End Function

Copykan juga script dibawah ini dengan memperhatikan prosedur-prosedur yang tertera

Private Sub cmdExit_Click()
    DeleteGeneratedDC BackDC
    Unload Me
    Set frmSideScroll1 = Nothing
End Sub

Private Sub cmdStart_Click()
    TimerScroll.Enabled = True
End Sub

Private Sub cmdStop_Click()
    TimerScroll.Enabled = False
End Sub

Private Sub Form_Load()
    BackDC = GenerateDC(App.Path & "\side.bmp")
    Me.Move Me.Left, Me.Top, 250 * Screen.TwipsPerPixelX, Me.Height
End Sub

Private Sub TimerScroll_Timer()
    Static X As Long
    Dim GlueWidth As Long, EndScroll As Long
    If X + ScrollWidth > BackLength Then
        GlueWidth = X + ScrollWidth - BackLength
        EndScroll = ScrollWidth - GlueWidth
        BitBlt Me.hdc, 0, 0, EndScroll, BackHeight, BackDC, X, 0, vbSrcCopy
        BitBlt Me.hdc, EndScroll, 0, GlueWidth, BackHeight, BackDC, 0, 0, vbSrcCopy
    Else
        BitBlt Me.hdc, 0, 0, ScrollWidth, BackHeight, BackDC, X, 0, vbSrcCopy
    End If
    Me.Refresh
    X = (X Mod BackLength) + 10
End Sub

Simpan dan jalankan/F5 maka animasi akan segera tampil dengan mengklik tombol start dan memberhentikan klik tombol Stop seperti gambar dibawah ini : 

Untuk Sourcodenya bisa agan-agan download di LINK INI