Cara Membuat Animasi Slide Scroll Image Dengan Kode VB6

Pada pertemuan kali ini saya akan berbagi sebuah kode animasi untuk menampilkan sebuah gambar seolah-olah berjalan dengan berganti gambar atau image secara slide yang biasanya kita temui dalam sebuah game.

Untuk lebih jelasnya perhatikan hasil outputnya pada gambar dibawah ini

output

Untuk membuatnya sangat mudah Anda cukup menambahkan 3 commandbutton dan 1 Timer dan mendesain formnya seperti gambar dibawah ini:

Copy-Paste kode di bawah ini :

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

Private Sub Command1_Click()

Timer1.Enabled = True

End Sub

Private Sub Command2_Click()

Timer1.Enabled = False

End Sub

Private Sub Command3_Click()

DeleteGeneratedDC BackDC

    Unload Me

    Set form11 = Nothing

End Sub

Private Sub Form_Load()

Timer1.Enabled = False

Timer1.Interval = 20

Form1.AutoRedraw = True

Form1.ScaleMode = 1

BackDC = GenerateDC(App.Path & "\kereta.bmp") 'gambar harus berekstension .bmp dan letakan gambar tersebut satu folder dengan form

    Me.Move Me.Left, Me.Top, 250 * Screen.TwipsPerPixelX, Me.Height

End Sub

Private Sub Timer1_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

Setelah mengcopy-paste kode diatas jalankan project Anda

Catatan:

• Gunakan Gambar dengan ekstension .BMP pada bagian kode " BackDC = GenerateDC(App.Path & "\kereta.bmp")"
• Simpan gambar .bmp satu folder dengan form imi

Demikian artikel pada hari ini tentang Cara Membuat Animasi Slide Scroll Image Dengan Kode VB6.

Semoga artikel ini bermanfaat buat kita semua,amin.

Selamat mencoba semoga berhasil

Related Post: Animasi