Cara Membuat Game Dari Visual Basic PART 4

Terinspirasi dengan permain kartu Black Jack, akhir nya game Black Jack made VB6 ini selesai juga.

Tampilan Game nya

Object yang di butuhkan

1 Buah Form
Beri nama : frmMain

1 Buah Modul
Beri nama : mdlKartu

11 Buah PictureBox
Beri nama : PlayerCard(0), PlayerCard(1), PlayerCard(2), PlayerCard(3) PlayerCard(4), EnemyCard(0), EnemyCard(1), EnemyCard(2), EnemyCard(3), EnemyCard(4), Source_Pic

1 Buah HScrollBar
Beri nama : BetScroll

3 Buah CommandButton
Beri nama : Deal_btn, Hit_btn, Stay_btn

1 Buah Timer
Ubah Interval menjadi 1000

7 Buah Label
Beri nama : Bet_lbl, ECash_Lbl, Deck_lbl, Enemy_lbl, Pvalue_lbl, PCash_lbl

1 Buah TextBox
Beri nama : Text1

3 Buah OptionButton
Beri nama : Option2, Option3, Option4

Listing Form [frmMain]

Private Sub BetScroll_Change()
If (Text1.Text = "") Then
MsgBox "Masukan nama kamu terlebih dahulu.", vbInformation + vbSystemModal, "Black Jack Card"
Else
betmoney = BetScroll.Value
Bet_lbl.Caption = "Rp " & betmoneyIf betmoney > 25 Then Deal_btn.Enabled = True Else: Deal_btn.Enabled = False
End If
End Sub
Private Sub Close_btn_Click()
Unload Me
End Sub
Private Sub Deal_btn_Click()
Dim i As Integer
BetScroll.Enabled = False
Deal_btn.Enabled = False
Hit_btn.Enabled = True
Stay_btn.Enabled = True
If cardposition > 43 Then shuffle_cardFor i = 1 To 2
player_hit
enemy_hitNext iCall display_card("enemyopen", 0)
End Sub
Private Sub Form_Activate()
Text1.SetFocus
End Sub
Private Sub Form_Load()
first_data
initialize_game
shuffle_cardSource_Pic.Picture = LoadPicture(App.Path & "\kartu.gif")
Option2.Value = True
Call BADDAYEnd Sub
Sub first_data()
Playercash = 2000
Enemycash = 20000
End Sub
Sub shuffle_card()
Dim i As Integer
Dim position As Integer
MsgBox "Dilarang Bajak Games ini", vbInformation + vbSystemModal, "Black Jack Card"
For i = 0 To (MAXCARD - 1)
carddeck(i) = 0
Next iFor i = 1 To MAXCARDDo
Randomize Timer
position = Int(Rnd * MAXCARD)
Loop Until carddeck(position) = 0
carddeck(position) = iNext i
cardposition = 1
End Sub
Sub enemy_hit()
Dim cardvalue As Integer
ECard(Ecounter) = carddeck(cardposition)
cardposition = cardposition + 1
Deck_lbl.Caption = "Sisa Kartu : " & (MAXCARD - cardposition)
Deck_lbl.Refresh
Call display_card("enemyclose", Ecounter)
cardvalue = ECard(Ecounter) Mod 13
If (cardvalue = 0) Or (cardvalue > 10) Then cardvalue = 10
If cardvalue = 1 Then
If (Etotalvalue + 11) <= 21 Then
cardvalue = 11
Else: cardvalue = 1
End If
End If
Etotalvalue = Etotalvalue + cardvalueEcounter = Ecounter + 1
End Sub
Sub player_hit()
PCard(Pcounter) = carddeck(cardposition)
cardposition = cardposition + 1
Deck_lbl.Caption = "Cards left: " & (MAXCARD - cardposition)
Deck_lbl.Refresh
Call display_card("player", Pcounter)
cardvalue = PCard(Pcounter) Mod 13
If (cardvalue = 0) Or (cardvalue > 10) Then cardvalue = 10
If cardvalue = 1 Then
If (Ptotalvalue + 11) <= 21 Then
cardvalue = 11
Else: cardvalue = 1
End If
End If
Ptotalvalue = Ptotalvalue + cardvaluePvalue_lbl.Caption = "Jumlah : " & Ptotalvalue
Pcounter = Pcounter + 1
End Sub
Sub display_card(who As String, counter As Integer)
Dim pic_cardrow As Integer
Dim pic_cardcolumn As Integer
Select Case whoCase "player"
pic_cardrow = Int((PCard(counter) - 1) / 13)
pic_cardcolumn = (PCard(counter) Mod 13) - 1
If pic_cardcolumn = -1 Then pic_cardcolumn = 12
PlayerCard(counter).Visible = True
BitBlt PlayerCard(counter).hDC, 0, 0, 80, 100, Source_Pic.hDC, pic_cardcolumn * 80, pic_cardrow * 100, vbSrcCopyPlayerCard(counter).Refresh
Case "enemyclose"
EnemyCard(counter).Visible = True
Case "enemyopen"
pic_cardrow = Int((ECard(counter) - 1) / 13)
pic_cardcolumn = (ECard(counter) Mod 13) - 1
If pic_cardcolumn = -1 Then pic_cardcolumn = 12
BitBlt EnemyCard(counter).hDC, 0, 0, 80, 100, Source_Pic.hDC, pic_cardcolumn * 80, pic_cardrow * 100, vbSrcCopyEnemyCard(counter).Refresh
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
CloseBADDAY
CloseYB
CloseHOME
Unload Me
End Sub
Private Sub Hit_btn_Click()
player_hitIf Etotalvalue < 17 Then
enemy_hitEnd If
If Pcounter = 5 Then check_winEnd Sub
Private Sub Option2_Click()
Call BADDAYCloseYB
CloseHOME
End Sub
Private Sub Option3_Click()
Call YBCloseBADDAY
CloseHOME
End Sub
Private Sub Option4_Click()
Call HOMECloseBADDAY
CloseYB
End Sub
Private Sub Stay_btn_Click()
Hit_btn.Enabled = False
Stay_btn.Enabled = False
While Etotalvalue < 17 And Ecounter < 5
enemy_hitWend
check_winEnd Sub
Sub check_win()
Dim i As Integer
Dim r As Integer
For i = 0 To (Ecounter - 1)
Call display_card("enemyopen", i)
Next iIf ((Etotalvalue > 21) And (Ptotalvalue > 21)) Or (Etotalvalue = Ptotalvalue) Or ((Ecounter = 5) And (Pcounter = 5)) Then
MsgBox "Kartu Seri", vbInformation + vbSystemModal, "Black Jack Card"
Else:
If (Ecounter = 5) Or (Ptotalvalue > 21) Or ((Etotalvalue < 22) And (Etotalvalue > Ptotalvalue)) Then
MsgBox "Kamu Kalah", vbInformation + vbSystemModal, "Black Jack Card"
If Etotalvalue = 21 Then betmoney = betmoney * 1.5
Playercash = Playercash - betmoneyEnemycash = Enemycash + betmoneyElse:
If (Pcounter = 5) Or (Etotalvalue > 21) Or ((Ptotalvalue < 22) And (Etotalvalue < Ptotalvalue)) Then
MsgBox "Kamu Menang", vbInformation + vbSystemModal, "Black Jack Card"
If Ptotalvalue = 21 Then betmoney = betmoney * 1.5
Playercash = Playercash + betmoneyEnemycash = Enemycash - betmoneyEnd If
End If
End If
display_moneyIf Playercash < 50 Then
MsgBox "Bangkrut", vbInformation + vbSystemModal, "Black Jack Card"
r = MsgBox("Main Lagi", vbYesNo + vbInformation + vbSystemModal, "Black Jack Card")
If r = vbYes Then first_data Else: CloseBADDAY: CloseYB: CloseHOME: End
Else:
If Enemycash <= 0 Then
MsgBox "Bangkrut", vbInformation, "Error Community"
r = MsgBox("Main Lagi", vbYesNo + vbInformation + vbSystemModal, "Black Jack Card")
If r = vbYes Then first_data Else: CloseBADDAY: CloseYB: CloseHOME: End
End If
End If
initialize_gameEnd Sub
Sub display_money()
PCash_lbl.Caption = "Rp " & Playercash
ECash_Lbl.Caption = "Rp " & Enemycash
End Sub
Sub initialize_game()
Dim i As Integer
BetScroll.Max = Playercash
BetScroll.Value = 0
BetScroll.Enabled = True
Deal_btn.Enabled = False
Hit_btn.Enabled = False
Stay_btn.Enabled = False
Pcounter = 0
Ecounter = 0
Ptotalvalue = 0
Pvalue_lbl.Caption = "Jumlah : " & Ptotalvalue
Etotalvalue = 0
display_moneyFor i = 0 To 4
PlayerCard(i).Cls
PlayerCard(i).Visible = False
EnemyCard(i).Cls
EnemyCard(i).Visible = False
Next iEnd Sub
Private Sub Timer1_Timer()
ServiceBackgroundMusic "BADDAY"
ServiceBackgroundMusic "YB"
ServiceBackgroundMusic "HOME"
End Sub

Listing Modul [mdlKartu]

Global Const MAXCARD = 52
Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _(ByVal lpstrCommand As String, _ByVal lpstrReturnString As String, _ByVal uReturnLength As Long, _ByVal hwndCallback As Long) As Long
Global Playercash As Integer
Global Enemycash As Integer
Global betmoney As Integer
Global cardposition As Integer
Global carddeck(MAXCARD - 1) As Integer
Global PCard(4) As Integer
Global ECard(4) As Integer
Global Ecounter As Integer
Global Pcounter As Integer
Global Etotalvalue As Integer
Global Ptotalvalue As Integer
Declare Function BitBlt Lib "gdi32" _(ByVal hDestDC&, _ByVal x&, _ByVal y&, _ByVal nWidth&, _ByVal nHeight&, _ByVal hSrcDC&, _ByVal xSrc&, _ByVal ySrc&, _ByVal dwRop&) As Long
Declare Function GetTickCount Lib "kernel32" () As Long
Sub delay(wait As Long)
Dim currenttick As Long
Dim lasttick As Long
lasttick = GetTickCount
Do
currenttick = GetTickCount
DoEvents
Loop Until ((currenttick - lasttick) > wait)
End Sub
Sub ServiceBackgroundMusic(Identifier As String)
Dim rt As Long
Dim Status As String
Status = "                         "
rt = mciSendString("STATUS " & Identifier & " MODE", Status, Len(Status), 0)
If rt = 0 Then
Status = Trim$(Status)
If Left(UCase$(Status), Len("STOPPED")) = "STOPPED" Then
mciSendString "PLAY " & Identifier & " FROM 0", "", 0, 0
End If
End If
End Sub
Sub BADDAY()
mciSendString "open BADDAY.wav alias BADDAY", 0&, 0, 0
mciSendString "play BADDAY from 0", 0&, 0, 0
End Sub
Sub CloseBADDAY()
mciSendString "stop BADDAY", 0&, 0, 0
mciSendString "close BADDAY", 0&, 0, 0
End Sub
Sub YB()
mciSendString "open YB.wav alias YB", 0&, 0, 0
mciSendString "play YB from 0", 0&, 0, 0
End Sub
Sub CloseYB()
mciSendString "stop YB", 0&, 0, 0
mciSendString "close YB", 0&, 0, 0
End Sub
Sub HOME()
mciSendString "open HOME.wav alias HOME", 0&, 0, 0
mciSendString "play HOME from 0", 0&, 0, 0
End Sub
Sub CloseHOME()
mciSendString "stop HOME", 0&, 0, 0
mciSendString "close HOME", 0&, 0, 0
End Sub

Credit by Jun-Qz N3

Artikel Terkait: