Skip to main content

Cara Membuat Game FlappyBird dengan VB6.0 - Part II

melanjutkan tutorial sebelumnya, tentang Cara membuat game flappybird dengan vb6.0
kali ini dilanjutkan dengan penambahan module dan prosedur untuk fungsi jatuh,musik,menabrak,danlain lain

Untuk itu, pertama buka file yang sudah sesuai dengan part I nya.
jangan lupa import dulu file tambahan berupa transparansi gambar.







2. buatlah modul, dengan nama seperti screenschoot gambar di bawah ini
Buat lah 3 File Modules
1. FuncMod
2. ModPicBuddy
3. ModSound







Pastekan Script Untuk FuncMod
Public started As Boolean
Public allHeight As Long
Public pipeHDistance As Long
Public pipeVDistance As Long
Public speed As Long
Public gameover As Boolean
Public entered As Boolean
Public scored1, scored4 As Boolean

Public Function CheckIfGameOver() As Boolean
    CheckIfGameOver = False
    Dim a, b, c, d, a1, b1, c1, d1 As Integer
    With frmMain
        a = .imgBird.Top
        b = .imgBird.Left
        c = b + .imgBird.Width
        d = a + .imgBird.Height
        
        If (Not gameover) Then
            a1 = .Image2.Top
            b1 = .Image2.Left
            c1 = b1 + .Image2.Width
            d1 = a1 + .Image2.Height
            
            If a <= d1 And (c >= b1 And b <= c1) Then
                Gameovered
            End If
        End If
        
        If (Not gameover) Then
            a1 = .Image3.Top
            b1 = .Image3.Left
            c1 = b1 + .Image3.Width
            d1 = a1 + .Image3.Height
            
            If a <= d1 And (c >= b1 And b <= c1) Then
                Gameovered
            End If
        End If
        
        If (Not gameover) Then
            a1 = .Image1.Top
            b1 = .Image1.Left
            c1 = b1 + .Image1.Width
            d1 = a1 + .Image1.Height
            
            If d >= a1 And (c >= b1 And b <= c1) Then
                Gameovered
            End If
        End If
        
        If (Not gameover) Then
            a1 = .Image4.Top
            b1 = .Image4.Left
            c1 = b1 + .Image4.Width
            d1 = a1 + .Image4.Height
            
            If d >= a1 And (c >= b1 And b <= c1) Then
                Gameovered
            End If
        End If
        
    End With
    
    CheckIfGameOver = gameover
End Function

Public Sub NewGame()
    frmMain.Timer1.Interval = 100
    gameover = False
    entered = False
    started = False
    scored1 = False
    scored4 = True
    frmMain.imgBird.Left = 1680
    frmMain.imgBird.Top = 1800
    frmMain.imgBird.Picture = LoadPicture(App.Path & "\img\bird.gif")
    frmMain.Command1.Left = 4680
    frmMain.Command1.Caption = "Flap"
    frmMain.Command2.Enabled = True
    
    frmMain.Image1.Top = 2760
    frmMain.Image1.Left = 4680
    frmMain.Image1.Height = 1455
    frmMain.Image2.Top = 0
    frmMain.Image2.Left = 4680
    frmMain.Image2.Height = 1335
    frmMain.Image3.Top = 0
    frmMain.Image3.Left = 8108
    frmMain.Image3.Height = 1695
    frmMain.Image4.Top = 3120
    frmMain.Image4.Left = 8108
    frmMain.Image4.Height = 1215
    
    frmMain.Label1.Caption = "0"
End Sub

Public Sub Gameovered()
    With frmMain
        .imgBird.Picture = LoadPicture(App.Path & "\img\bird-dead.gif")
        If Not .imgBird.Top >= 3600 Then
            .tmrMove.Enabled = False
            .Command1.Enabled = False
            .Timer1.Enabled = False
            .Timer1.Interval = 20
            .Timer1.Enabled = True
        Else
            .Timer1.Enabled = False
        End If
        PlaySound App.Path & "\img\gameover.wav", 0, SND_FILENAME Or SND_ASYNC
        .Command1.Caption = "New Game"
        .Command1.Enabled = True
        .Command1.Left = 1200
        .Command2.Enabled = False
        gameover = True
        .tmrMove.Enabled = False
    End With
End Sub

Dan Modules ModPicBuddy
Option Explicit


'From : www.rakaadinugroho.blogspot.com
'admin : Raka Adi Nugroho


Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function ClientToScreen Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As Long
Private Declare Function SetBkMode Lib "gdi32.dll" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function SetWindowOrgEx Lib "gdi32.dll" (ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT, ByVal bErase As Long) As Long
Private Const NULL_BRUSH As Long = 5
Private Const NEWTRANSPARENT As Long = 3
Private Const WM_CTLCOLORSTATIC As Long = &H138
Private Const WM_PAINT As Long = &HF&
Private Const WM_ERASEBKGND As Long = &H14
Private Const WM_ENABLE As Long = &HA
Private Const WM_PRINTCLIENT As Long = &H318
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type POINTAPI
    X As Long
    Y As Long
End Type


Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function comctl32DllGetVersion Lib "comctl32" Alias "DllGetVersion" (pdvi As DLLVERSIONINFO) As Long
Private Declare Function IsAppThemed Lib "uxtheme.dll" () As Long
Private Declare Function IsThemeActive Lib "uxtheme.dll" () As Long
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Const WM_THEMECHANGD As Long = &H31A&
Private Type DLLVERSIONINFO
    cbSize As Long
    dwMajor As Long
    dwMinor As Long
    dwBuildNumber As Long
    dwPlatformID As Long
End Type

Private m_Themed As Boolean

Public Function ValidateThemeEmployed() As Boolean
'untuk determinan file

    Dim lVersionInfo As Long, hMod As Long, fa As Long
    Dim tdVI As DLLVERSIONINFO
    
    lVersionInfo = GetVersion()
    Select Case (lVersionInfo And &HFF)
        Case 6&
            m_Themed = True
        Case 5&
            m_Themed = ((lVersionInfo And &HFF00&) \ &H100 > 0&)
            ' jika minor
            
        Case Else
            m_Themed = False
    End Select
    If m_Themed Then
        m_Themed = False
        If IsThemeActive() Then
            If IsAppThemed() Then
                hMod = LoadLibrary("comctl32.dll")
                If hMod Then
                    fa = GetProcAddress(hMod, "DllGetVersion")
                    If fa Then
                       tdVI.cbSize = Len(tdVI)
                       fa = comctl32DllGetVersion(tdVI)
                       If fa = 0& Then
                          m_Themed = (tdVI.dwMajor > 5&)
                       End If
                    End If
                    FreeLibrary hMod
                End If
            End If
        End If
    End If
    ValidateThemeEmployed = m_Themed
    
End Function

Public Function picBuddyWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    
    Dim lProc As Long
    lProc = GetProp(hwnd, "WndProc")
    Select Case uMsg
        Case WM_CTLCOLORSTATIC 'perintah message
            If GetProp(lParam, "WndProc") Then
                Dim vPT As POINTAPI
                CallWindowProc lProc, hwnd, uMsg, wParam, lParam
                If GetProp(lParam, "EraseBkg") = 1& Or m_Themed = True Then
                    SetProp lParam, "EraseBkg", 0
                    ClientToScreen lParam, vPT
                    ScreenToClient hwnd, vPT
                    SetWindowOrgEx wParam, vPT.X, vPT.Y, vPT
                    SendMessage hwnd, WM_PAINT, wParam, ByVal 0&
                    SetWindowOrgEx wParam, vPT.X, vPT.Y, vPT
                End If
                lProc = 0&                                      ' jangan hilangkan kode ini
                SetBkMode wParam, NEWTRANSPARENT
                picBuddyWindowProc = GetStockObject(NULL_BRUSH)
            End If
        
        Case WM_ERASEBKGND
            If m_Themed = False Then
                If GetProp(hwnd, "ChildBtn") Then SetProp hwnd, "EraseBkg", 1&
            End If
            
        Case WM_THEMECHANGD
            If GetProp(hwnd, "ChildBtn") = 0& Then ValidateThemeEmployed
        
        Case WM_ENABLE
            If GetProp(hwnd, "ChildBtn") Then
                Dim wRect As RECT, iPt As POINTAPI
                picBuddyWindowProc = CallWindowProc(lProc, hwnd, uMsg, wParam, lParam)
                GetClientRect hwnd, wRect
                InvalidateRect hwnd, wRect, True
                lProc = 0&
            End If
    End Select
    If lProc Then picBuddyWindowProc = CallWindowProc(lProc, hwnd, uMsg, wParam, lParam)

End Function

dan yang terakhir  Mod Sound

Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _
    (ByVal lpszName As String, _
     ByVal hModule As Long, _
     ByVal dwFlags As Long) As Long
Private Const SND_APPLICATION As Long = &H80
Private Const SND_ALIAS As Long = &H10000
Private Const SND_ALIAS_ID As Long = &H110000
Private Const SND_ASYNC As Long = &H1
Private Const SND_FILENAME As Long = &H20000
Private Const SND_LOOP As Long = &H8
Private Const SND_MEMORY As Long = &H4
Private Const SND_NODEFAULT As Long = &H2
Private Const SND_NOSTOP As Long = &H10
Private Const SND_NOWAIT As Long = &H2000
Private Const SND_PURGE As Long = &H40
Private Const SND_RESOURCE As Long = &H40004
Private Const SND_SYNC As Long = &H0

Jadilah Game FlappyBird Versi Anda.
Keep Koding
Labels:

Comments

  1. UnknownMay 20, 2014 at 9:43 PM

    kok saya debug sih??

    ReplyDelete
  2. UnknownDecember 6, 2014 at 1:45 PM

    @-) gan minta pencerahan,kalo image1 yg mana image2 yng mana image3 yang mana image4 yang mana image5yang mana, image6 yang mana gan ,, sya bingung di image nya,,,?

    ReplyDelete
    Replies
    1. UnknownDecember 7, 2014 at 1:42 AM

      download dulu asetnya di tutorial yang pertama kang :>)

      Delete
    2. Monica SanNovember 21, 2017 at 3:42 PM

      asetnya maksudnya yg zip gambar-flappybird-rakaadinugroho kan? itu nama filenya kan bird,bird-up,bird-dead,pipe-down,pipe-up,dst... jadi yang Image1, Image2, dst itu yang mana ya?

      Delete
    3. Raka Adi NugrohoJanuary 26, 2018 at 12:33 PM

      didalemnya ada om. silahkan cek-cek kembali

      Delete
  3. Elisabeth NathasyaDecember 28, 2018 at 7:57 PM

    saya dah ngikutin semua langkahnya tapi kok error ya.. muncul tulisan "Compile Error : Procedure declaration does not match description of event or procedure having the same name"

    ReplyDelete
    Replies
    1. Elisabeth NathasyaDecember 28, 2018 at 8:02 PM

      oh iya saya baru pertama ini pake visual basic dan membuat program2 jadinya ngga mengerti..

      Delete

Post a Comment

Popular posts from this blog

Membuat Login Register Dengan Verifikasi Email PHP MySQL

selamat siang, sudah dua bulan tidak memberikan update, setelah terakhir update masalah nodejs dan angular . kali ini saya akan berbagi tutorial. bagaimana cara membuat register dengan php, namun dengan verifikasi email. pertama seperti biasa buatlah database " rakaadinugroho ". setelah itu eksekusi sql dibawah ini: CREATE TABLE IF NOT EXISTS `pengguna` (   `id` int(1) NOT NULL AUTO_INCREMENT,   `nama` varchar(225) COLLATE utf8_unicode_ci NOT NULL,   `password` varchar(225) COLLATE utf8_unicode_ci NOT NULL,   `email` varchar(225) COLLATE utf8_unicode_ci NOT NULL,   `kode` varchar(225) COLLATE utf8_unicode_ci NOT NULL,   `status` int(1) NOT NULL DEFAULT '0',   PRIMARY KEY (`id`),   UNIQUE KEY `email` (`email`) ) ENGINE=MyISAM  DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci AUTO_INCREMENT=3 ; setelah itu buat file konektornya, buat " koneksi.php ". kodenya seperti dibawah ini: <?php mysql_connect("localhost","root",&qu
21 comments
Read more

Source Code Kuesioner Mahasiswa Online PHP+MySQL+Bootstrap

Alhamdulillah, selamat pagi. salam sejahtera bagi kita semua terutama pengunjung raka adi nugroho blogs. Pengumuman! Aplikasi Kuesioner Semakin Berkembang. Update Apa Saja? - Perubahan Besar-besaran, ditulis dengan Framework CI - Struktur yang sangat berbeda, Kuesioner Pertopik dan Per Sub Topik - Jadi, Jika Anda Membeli. Anda Akan Mendapatkan 2 Aplikasi Kuesioner pagi ini, setelah lama vakum karena mengerjakan projek yang akan saya update kali ini. yaitu projek tugas akhir yang katanya sulit rumit dan susah . yaitu software kajian kuesioner mahasiswa online untuk mengambil hak angketnya terhadap kualitas dosen disebuah universitas. langsung saja, disini saya menggunakan bootstrap agar lebih stylish Diatas adalah gambar dari Databasenya Diatas adalah Gambar Login pemilik Hak Angket Gambar, Pendaftaran Hak Angket Gambar Berhasil Login Gambar Kuesionernya I Gambar Kuesionernya II Hak Angket Sudah diGunakan Gambar Administrator Area,
26 comments
Read more

MENCARI SUARA: APAKAH SAYA LANJUTKAN TUTORIAL SAYA VIA YOUTUBE

Halo Apakabar teman-teman, baik yang sudah mahir maupun baru memulai masuk dalam dunia pemrograman. saya sudah sangat lama tidak menulis, mungkin karena beberapa kesibukan saya. ditulisan ini saya ingin meminta pendapat pembaca, apakah lebih baik saya menulis tutorial di blog atau membuat tutorial video ( upload youtube ). dan konten yang harus saya isi di 2017 ini apa, mohon komentarnya. :D
5 comments
Read more