i got bored and made this
tell me what you think and i hope it keeps you amused for a few mins.
Code:program new; { 1 = ace 11 = jack 12 = queen 13 = king } Type TCard = record Suite:Char; Number:Integer; end; var Deck: Array [1..52] of TCard; DeckI, YourScore, HouseScore: Integer; function Card(suite: Char; Number: Integer):TCard; begin result.Suite := Suite; Result.number := number; end; Procedure generateDeck; var I, II: integer; s: Char; begin for I := 1 to 4 do begin case I of 1: s := 'h'; 2: s := 'd'; 3: S := 'c'; 4: S := 's'; end; for II := 1 to 13 do begin Deck[((I-1)*13)+II] := Card(S, II); end; end; end; procedure suffledeck; var TDeck: Array [1..52] of TCard; I, T: Integer; Done: Boolean; begin for I := 1 to 52 do begin done := false; repeat T := (Random(52)+1); // writeln(T); if TDeck[T].Number = 0 then begin // writeln(I); TDeck[T] := Deck[I]; done := true; end; until done; end; for I := 1 to 52 do Deck[I] := TDeck[I]; end; procedure WriteCard( Card: TCard); var Suite: String; Name: String; begin case Card.Suite of 's': Suite := 'Spades'; 'd': Suite := 'Diamonds'; 'h': Suite := 'Hearts'; 'c': Suite := 'Clubs'; end; case Card.Number of 1: Name := 'Ace'; 2..10: Name := IntToStr(Card.Number); 11: Name := 'Jack'; 12: Name := 'Queen'; 13: Name := 'King'; end; Writeln(Name + ' of ' + Suite); end; Procedure WriteTable(YourCards, DealersCards: Array of TCard; ShowDealers: Boolean); var I: Integer; begin ClearDebug; Writeln('your Cards:'); for I := 0 to high(YourCards) do WriteCard(YourCards[I]); Writeln(''); Writeln('Dealers cards:'); if not ShowDealers then begin writeCard(Deck[3]); Writeln('**********'); end else begin for I := 0 to high(DealersCards) do WriteCard(DealersCards[I]); end; end; procedure AddToHand( Card: TCard; var Hand: Array of TCard); begin setArrayLength(Hand, High(Hand)+2); // writeln(High(Hand)); Hand[High(Hand)] := Card; end; function HandValue(Hand: Array of TCard):Integer; var I: Integer; Ace: Boolean; begin result := 0; for I := 0 to High(Hand) do begin case Hand[I].Number of 1: if Ace then IncEx(Result, 1) else Ace := True; //if we already have 1 ace 2 will put us over 21 2..10: IncEx(Result, Hand[i].Number); 11..13: IncEx(Result, 10); end; end; if ace then if (Result + 11) > 21 then IncEx(Result, 1) else IncEx(Result, 11); end; procedure Deal; var I, D5: Integer; YourCards, DealersCards:Array of TCard; fin: Boolean; begin YourCards := [Deck[1], Deck[2]]; DealersCards := [Deck[3], Deck[4]]; if HandValue(YourCards) = 21 then begin WriteTable(YourCards, DealersCards, True); writeln(''); Writeln('Blackjack! you win'); inc(yourScore); exit; end; for DeckI := 5 to 8 do begin WriteTable(YourCards, DealersCards, False); case MessageBox('Hit?', 'Hit or stand?', 4) of 6: AddToHand(Deck[DeckI], YourCards); //yes 7: fin := true;//no end; if fin then Break; if HandValue(YourCards) > 21 then begin WriteTable(YourCards, DealersCards, True); Writeln(''); Writeln('Sorry you are bust'); inc(HouseScore); exit; end; end; if DeckI = 8 then begin WriteTable(YourCards, DealersCards, True); writeln(''); Writeln('5 Cards you win!'); inc(yourScore); exit; end; D5 := DeckI + 3; While HandValue(DealersCards) < 16 do begin AddToHand(Deck[DeckI], DealersCards); Inc(DeckI); if DeckI = D5 then begin WriteTable(YourCards, DealersCards, True); writeln(''); Writeln('Dealer got 5 cards, you lose'); inc(HouseScore); exit; end; end; WriteTable(YourCards, DealersCards, True); writeln(''); if HandValue(DealersCards) > 21 then begin Writeln('Dealer busts, you win!'); inc(yourScore); exit; end; if HandValue(YourCards) = HandValue(DealersCards) then Writeln('Draw, House wins if its a draw'); if HandValue(YourCards) > HandValue(DealersCards) then begin Writeln('Well played you won!'); inc(yourScore); end else begin Writeln('Unlucky you lost'); inc(houseScore); end; end; begin GenerateDeck; repeat suffleDeck; Deal; writeln('you: '+Inttostr(yourScore) + ' House: ' +Inttostr(HouseScore)); until MessageBox('Play again?', 'again?', 4) = 7; end.




Reply With Quote






