http://www.powerbasic.com/support/downl ... gaz043.txt
http://www.purebasic.fr/english/viewtop ... d0d5ad1179
http://www.catch22.net/tuts/cards
Tested on my WinXP 32bit pc. Might not work for some people, apparently if you do not install your win os with the microsoft game solitaire, there might not be a 'cards.dll' in your windows system32 folder.
Useful dll IMO, can be used for any card game (poker, gin rummy, solitaire..etc)
Sourcecode :
Code: Select all
;BOOL WINAPI cdtInit (int *width, int *height) initializes dll
;BOOL WINAPI cdtDraw (HDC hdc, int x, int y, int card, int type, DWORD color) draws the cards
;void WINAPI cdtTerm (void) cleans up the card resources
;using function cdtDraw, card default dimensions in pixels are
;height = 96 width = 71
#card_width = 71 : #card_height = 96
win_id = OpenWindow(#PB_Any,#PB_Default,#PB_Default,640,480,"[Made with Purebasic 4.31 demo]",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered)
dll_id = OpenLibrary(#PB_Any,"cards.dll")
Define.i cwidth, cheight : CallFunction(dll_id,"cdtInit",@cwidth,@cheight)
;to draw the back of the card with a color specified
;<type> should be 4 Or 5 Or <card> = 53 and <type> = 1 (different patterns) <color> is an rgb value
;to draw the back of the card with a shuffling effect and a specified color
;<type> should be 3 (it kinda looks like it's shuffling)
;to draw the back of the card using the 16 predefined bitmaps in cards.dll
;<type> must be 1, and <card> must be a value from 54 - 68
;to draw the front <type> should be 0, <card> should be a value from 0 - 51
;The card faces are organised in increasing order. That is, the aces
;come first, then the two's and so on. In each group, the cards are
;ordered by suit. The order is clubs, diamons, hearts, spades. This pattern
;is repeated As the card values increase.
;Where 0 - clubs, 1 - diamonds, 2 - hearts, 3 - spades
;To calculate the value of card given a suit (0-3) And a face value (0-13,
;0 being aces, 13 being kings), you can use this simple formula:
;card = suit + face * 4
;card value can be obtained by using the formula (value = card / 4 + 1)
;if value > 10 then value = 10 (for jack, queen and king)
backcolor = RGB(255,120,120)
Dim deck.i(52)
For count = 0 To 51 Step 1 : deck(count) = count : Next count
;create gadgets
stay_id = ButtonGadget(#PB_Any, 120, 410, 80, 40, "Stay") : hit_id = ButtonGadget(#PB_Any, 20, 410, 80, 40, "Hit")
bet_id = ButtonGadget(#PB_Any, 220, 410, 80, 40, "Bet") : bet_amount_id = SpinGadget(#PB_Any, 330, 430, 90, 20, 0, 10)
TextGadget(#PB_Any, 330, 410, 80, 20, "Amount to bet :") : TextGadget(#PB_Any, 460, 410, 80, 20, "Your cash :")
cash_id = TextGadget(#PB_Any, 460, 430, 80, 20, "$0") : stakes_id = TextGadget(#PB_Any, 470, 220, 110, 20, "Stakes : $0")
TextGadget(#PB_Any, 460, 0, 80, 20, "Bank :") : bank_id = TextGadget(#PB_Any, 460, 20, 80, 20, "$0")
dealer_extra = 0 : player_extra = 0 ;max 3, extra cards player or dealer ask for
game_state = 0 ;0 - place bets, 1 - deal cards, 2 - player ask for card, 3 - dealer ask for card, 4 - determine winner
menu_id = CreateMenu(#PB_Any,WindowID(win_id))
MenuTitle("&Menu") : MenuItem(1,"Re&start") : MenuItem(2,"&Help") : MenuItem(3,"E&xit")
AddKeyboardShortcut(win_id,#PB_Shortcut_Escape,3)
Dim dealer_hand.i(5) : Dim player_hand.i(5)
dealer_cash.i = 1000 : player_cash.i = 1000
SetGadgetText(bank_id,"$" + Str(dealer_cash)) : SetGadgetText(cash_id,"$" + Str(player_cash))
DisableGadget(hit_id,1) : DisableGadget(stay_id,1) : DisableGadget(bet_id,1)
bet_amount.i = 0 : stakes.i = 0
SetGadgetText(bet_amount_id,"$" + Str(bet_amount)) : SetGadgetState(bet_amount_id,0)
SetGadgetText(stakes_id,"Stakes : $" + Str(stakes))
instructions.s = "You start off with a $1000 account. The dealer also starts of with $1000. The game is over when either" + Chr(10)
instructions + "you or the dealer goes bust (bankrupt). The minimum bet is $30, the maximum bet is $300. You first place" + Chr(10)
instructions + "the amount you would like to bet (in $10's only). Two cards are then dealt at the start of the game." + Chr(10)
instructions + "You have the choice of asking for another card by clicking the 'Hit' button or by clicking the 'Stay'" + Chr(10)
instructions + "button for no cards. After you have requested no more cards, the dealer then has the choice" + Chr(10)
instructions + "to take another card, he will always take a card if his hand is less than 16, and will always" + Chr(10)
instructions + "stay if it is above or equal to 17." + Chr(10) + Chr(10)
instructions + "An Ace and a 10-card or a King or a Queen or a Jack constitute 21 or 'BlackJack', If you and" + Chr(10)
instructions + "the dealer both have this hand 21 or 'BlackJack', if you and the dealer both have this hand" + Chr(10)
instructions + "the result is a draw so the next game begins to determine the winner. Note : There's no split-pair," + Chr(10)
instructions + ",two aces are also counted as a 'BlackJack'. The second highest hand is a 'Five-Card-Charlie'," + Chr(10)
instructions + "or a hand with 5 cards the sum of which is less than or equal to 21. The third" + Chr(10)
instructions + "highest rank is a 21 count, with 3 or more cards and the fourth highest rank is a 21 count, with 3" + Chr(10)
instructions + "or more cards and the fourt highest rank is any card that has a higher sum but not exceeding 21." + Chr(10)
instructions + "If your hand exceeds 21 it is a bust and the dealer wins, unless his hand also exceeds" + Chr(10)
instructions + "21 which in this case means a draw."
Repeat
event = WindowEvent()
If event = #PB_Event_Menu
If EventMenu() = 3 : Break : EndIf
If EventMenu() = 2 : MessageRequester("Instructions",instructions.s) : EndIf
If EventMenu() = 1 ;game restart
dealer_cash = 1000 : player_cash = 1000
SetGadgetText(bank_id,"$" + Str(dealer_cash)) : SetGadgetText(cash_id,"$" + Str(player_cash))
DisableGadget(hit_id,1) : DisableGadget(stay_id,1) : DisableGadget(bet_id,1) : DisableGadget(bet_amount_id,0)
bet_amount.i = 0 : stakes.i = 0
SetGadgetText(bet_amount_id,"$" + Str(bet_amount)) : SetGadgetState(bet_amount_id,0)
SetGadgetText(stakes_id,"Stakes : $" + Str(stakes)) : game_state = 0
EndIf
EndIf
;placing your bet
If event = #PB_Event_Gadget And game_state = 0
If EventGadget() = bet_amount_id
If player_cash < 300 : SetGadgetAttribute(bet_amount_id,#PB_Spin_Maximum,player_cash / 10) : EndIf
If player_cash >= 300 : SetGadgetAttribute(bet_amount_id,#PB_Spin_Maximum,30) : EndIf
SetGadgetText(bet_amount_id,Str(GetGadgetState(bet_amount_id)))
temp = Val(GetGadgetText(bet_amount_id)) * 10 : SetGadgetText(bet_amount_id,"$"+Str(temp))
SetGadgetText(cash_id,"$" + Str(player_cash - GetGadgetState(bet_amount_id) * 10))
EndIf
If GetGadgetState(bet_amount_id) >= 3 : DisableGadget(bet_id,0) : Else : DisableGadget(bet_id,1) : EndIf
EndIf
;confirm placing your bet
If game_state = 0 And event = #PB_Event_Gadget
If EventGadget() = bet_id
DisableGadget(bet_amount_id,1) : DisableGadget(bet_id,1)
If dealer_cash < GetGadgetState(bet_amount_id) * 10
SetGadgetText(bet_amount_id,"$" + Str(dealer_cash)) : SetGadgetState(bet_amount_id,dealer_cash/10)
SetGadgetText(cash_id,"$" + Str(player_cash - GetGadgetState(bet_amount_id) * 10))
EndIf
player_cash - GetGadgetState(bet_amount_id)*10 : dealer_cash - GetGadgetState(bet_amount_id)*10
stakes = GetGadgetState(bet_amount_id) * 10 * 2 : SetGadgetText(stakes_id,"Stakes : $" + Str(stakes))
SetGadgetText(bank_id,"$" + Str(dealer_cash)) : game_state = 1
EndIf
EndIf
;bet has been placed so shuffle deck and deal cards
If game_state = 1
player_extra = 0 : dealer_extra = 0
For count = 0 To 51 Step 1 ;shuffle card
temp1.i = Random(51) : If temp1 <> count : temp2 = deck(temp1) : deck(temp1) = deck(count) : deck(count) = temp2 : EndIf
Next count
For count = 0 To 4 Step 1 : dealer_hand(count) = -1 : player_hand(count) = -1 : Next count ;clear player and dealer hand
For count = 0 To 4 Step 1 : dealer_hand(count) = deck(count) : player_hand(count) = deck(count+4) : Next count ;deal cards to dealer and player
DisableGadget(hit_id,0) : DisableGadget(stay_id,0) : game_state = 2
EndIf
;display cards all face down when player is placing a bet
If game_state < 2
whandle = StartDrawing(WindowOutput(win_id))
tempx = 40 : tempy = 280
For count = 0 To 4 Step 1
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,53,1,backcolor) : tempx + #card_width + 5
Next count
tempx = 40 : tempy = 40
For count = 0 To 4 Step 1
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,53,1,backcolor) : tempx + #card_width + 5
Next count
StopDrawing()
EndIf
;display cards while player can still ask for an extra card
If game_state >= 2
tempx = 40 : tempy = 280
whandle = StartDrawing(WindowOutput(win_id))
For count = 0 To 1 Step 1 ;draw the first two cards for player
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,player_hand(count),0,backcolor) : tempx + #card_width + 5
Next count
temp = player_extra
For count = 2 To 4 Step 1 ;draw remaining 3 cards for player, either face up/down depending on <player_extra>
If temp > 0 ;draw any extra cards facing up
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,player_hand(count),0,backcolor) : tempx + #card_width + 5 : temp - 1
Else ;draw remainder cards facing down
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,53,1,backcolor) : tempx + #card_width + 5
EndIf
Next count
tempx = 40 : tempy = 40
;draw the first two cards for dealer
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,dealer_hand(0),0,backcolor) : tempx + #card_width + 5
If game_state >= 3 ;second card face up or face down?
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,dealer_hand(1),0,backcolor) : tempx + #card_width + 5
Else
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,53,1,backcolor) : tempx + #card_width + 5
EndIf
temp = dealer_extra
For count = 2 To 4 Step 1 ;draw remaining 3 cards for dealers hand
If temp > 0
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,dealer_hand(count),0,backcolor) : tempx + #card_width + 5 : temp - 1
Else
CallFunction(dll_id,"cdtDraw",whandle,tempx,tempy,53,1,backcolor) : tempx + #card_width + 5
EndIf
Next count
StopDrawing()
EndIf
;get player input for asking an extra card
If game_state = 2 And event = #PB_Event_Gadget
If EventGadget() = hit_id : player_extra + 1 : EndIf
If player_extra = 3 : hit_disabled = 1 : game_state = 3 : EndIf
If EventGadget() = stay_id : game_state = 3 : EndIf
If game_state = 3 : DisableGadget(hit_id,1) : DisableGadget(stay_id,1) : EndIf
EndIf
;dealer's turn to ask for cards
If game_state = 3
temp1 = Int(dealer_hand(0) / 4 + 1) : temp2 = Int(dealer_hand(1) / 4 + 1)
If temp1 > 10 : temp1 = 10 : EndIf : If temp2 > 10 : temp2 = 10 : EndIf
If temp1 = 1 And temp2 = 1 And dealer_extra = 0 : temp = 21 : EndIf ;2 aces = 21
If (temp1 = 1 And temp2 = 10) Or (temp1 = 10 And temp2 = 1) And dealer_extra = 0 : temp = 21 : EndIf ;10 and ace = 21
If temp <> 21 ;assume ace is 11 if first card + second card >= 17, else assume all aces are 1 to try for a 5 card charlie
;add up all non-aces and count any aces if found
not_aces = 0 : aces = 0
For count = 0 To 1 + dealer_extra
temp1 = Int(dealer_hand(count) / 4 + 1)
If temp1 > 1 And temp1 > 10 : not_aces + 10 : EndIf
If temp1 > 1 And temp1 <= 10 : not_aces + temp1 : EndIf
If temp1 = 1 : aces + 1 : EndIf
Next count
temp = not_aces + aces
If temp < 17 And dealer_extra < 3 : dealer_extra + 1 : Continue : EndIf ;<continue> is used to skip to the start of the main repeat loop so that the extra card is displayed face up
EndIf
If dealer_extra = 3 Or temp >= 17 : game_state = 4 : Continue : EndIf
EndIf
;determine winner
If game_state = 4
;add up dealer's hand
dealer_sum = 0
temp1 = Int(dealer_hand(0) / 4 + 1) : temp2 = Int(dealer_hand(1) / 4 + 1)
If temp1 > 10 : temp1 = 10 : EndIf : If temp2 > 10 : temp2 = 10 : EndIf
If temp1 = 1 And temp2 = 1 And dealer_extra = 0 : dealer_sum = 21 : EndIf ;2 aces = 21
If (temp1 = 1 And temp2 = 10) Or (temp1 = 10 And temp2 = 1) And dealer_extra = 0 : dealer_sum = 21 : EndIf ;10 and ace = 21
If dealer_sum <> 21 ;assume ace is 11 if first card + second card >= 17, else assume all aces are 1 to try for a 5 card charlie
;add up all non-aces and count any aces if found
not_aces = 0 : aces = 0
For count = 0 To 1 + dealer_extra
temp1 = Int(dealer_hand(count) / 4 + 1)
If temp1 > 1 And temp1 > 10 : not_aces + 10 : EndIf
If temp1 > 1 And temp1 <= 10 : not_aces + temp1 : EndIf
If temp1 = 1 : aces + 1 : EndIf
Next count
dealer_sum = not_aces + aces
EndIf
;add up player's hand
player_sum = 0
temp1 = Int(player_hand(0) / 4 + 1) : temp2 = Int(player_hand(1) / 4 + 1)
If temp1 > 10 : temp1 = 10 : EndIf : If temp2 > 10 : temp2 = 10 : EndIf
If temp1 = 1 And temp2 = 1 And player_extra = 0 : player_sum = 21 : EndIf
If (temp1 = 1 And temp2 = 10) Or (temp1 = 10 And temp2 = 1) And dealer_extra = 0 : player_sum = 21 : EndIf
If player_sum <> 21
not_aces = 0 : aces = 0
For count = 0 To 1 + player_extra
temp1 = Int(player_hand(count) / 4 + 1)
If temp1 > 1 And temp1 > 10 : not_aces + 10 : EndIf
If temp1 > 1 And temp1 <= 10 : not_aces + temp1 : EndIf
If temp1 = 1 : aces + 1 : EndIf
Next count
If aces = 1
If not_aces + 11 <= 21 : player_sum = not_aces + 11 : Else : player_sum = not_aces + 1 : EndIf
ElseIf aces > 1
If not_aces + 11 + (aces - 1) <= 21 : player_sum = not_aces + 11 + (aces - 1) : Else : player_sum = not_aces + aces : EndIf
ElseIf aces = 0
player_sum = not_aces
EndIf
EndIf
;compare player and dealer hands to see who is the winner
;determine a draw if found, then replay
If player_extra = dealer_extra And player_sum = dealer_sum : game_state = 1 : EndIf ;identical deadlock
If (player_extra > 0 Or dealer_extra > 0) And player_sum = dealer_sum : game_state = 1 : EndIf
If player_extra = 3 And dealer_extra = 3 And player_sum <= 21 And dealer_sum <= 21 : game_state = 1 : EndIf ;5 card deadlock
If player_extra < 3 And player_extra > 0 And dealer_extra < 3 And dealer_extra > 0
If player_sum = dealer_sum : game_state = 1 : EndIf ;non 5 card deadlock
EndIf
If player_sum > 21 And dealer_sum > 21 : game_state = 1 : EndIf ;bust deadlock
;exception for a hand that has blackjack (bug fix)
If (player_sum = 21 Or dealer_sum = 21) And (player_extra = 0 Or dealer_extra = 0) And player_extra <> dealer_extra
game_state = 4
EndIf
If game_state = 1 : MessageRequester("","It's a draw!!") : EndIf
;determine winner if a blackjack is found
If game_state <> 1
player_wins = -1
If player_extra = 0 And player_sum = 21 And player_wins = -1 : MessageRequester("","Player has blackjack!! Player wins.") : player_wins = 1 : EndIf
If dealer_extra = 0 And dealer_sum = 21 And player_wins = -1 : MessageRequester("","Dealer has blackjack!! Dealer wins.") : player_wins = 0 : EndIf
If player_extra = 3 And player_sum <= 21 And player_wins = -1 : MessageRequester("","Player has 5 card charlie!! Player wins.") : player_wins = 1 : EndIf
If dealer_extra = 3 And dealer_sum <= 21 And player_wins = -1 : MessageRequester("","Dealer has 5 card charlie!! Dealer wins.") : player_wins = 0 : EndIf
If player_sum <= 21 And dealer_sum <= 21 And player_sum > dealer_sum And player_wins = -1
MessageRequester("","Player has the better hand!! Player wins.") : player_wins = 1
EndIf
If dealer_sum <= 21 And player_sum <= 21 And dealer_sum > player_sum And player_wins = -1
MessageRequester("","Dealer has the better hand!! Dealer wins.") : player_wins = 0
EndIf
If dealer_sum > 21 And player_sum <= 21 And player_wins = -1 : MessageRequester("","Dealer busted!! Player wins.") : player_wins = 1 : EndIf
If player_sum > 21 And dealer_sum <= 21 And player_wins = -1 : MessageRequester("","Player busted!! Dealer wins.") : player_wins = 0 : EndIf
If player_wins = 1 : player_cash + stakes : SetGadgetText(cash_id,"$" + Str(player_cash)) : EndIf
If player_wins = 0 : dealer_cash + stakes : SetGadgetText(bank_id,"$" + Str(dealer_cash)) : EndIf
stakes = 0 : SetGadgetText(stakes_id,"Stakes : $" + Str(stakes)) : game_state = 0
SetGadgetState(bet_amount_id,0) : DisableGadget(bet_amount_id,0) : SetGadgetText(bet_amount_id,"$0")
If player_cash < 30 : MessageRequester("","You are broke. Choose 'Restart' from the menu options to play again") : EndIf
If dealer_cash < 30 : MessageRequester("","You broke the bank. Choose 'Restart' from the menu options to play again") : EndIf
If player_cash < 30 Or dealer_cash < 30 : game_state = -1 : EndIf
EndIf
EndIf
Until event = #PB_Event_CloseWindow
CallFunction(dll_id,"cdtTerm")
CloseLibrary(dll_id)
End
