Code:
declare function chkcardval(cname$)
declare function chkcardsuit$(cname$)
declare function rndcard$()
cls
np=4 'Number of players. change to your needs
'dims the player array
'the first d is the number of players
'the second d is the number of in wich he gets the card
'(sorry cant explain think of any other way to explain that)
dim player$(np,52)
randomize timer
for p=1 to np ' does for number of players
for i=1 to (52/np) ' divides the deck
1
player$(p,i) = rndcard$() ' gets the card
for a= 1 to np
for n = 1 to (52/np) 'this checks to make
if a=p and n=i then n=n+1
if player$ (p,i) = player$(a,n) then goto 1'sure the card isnt
next 'repeated
next
next
next
'the rest of this prints out the player and card names
c=1
for p=1 to np ' for the number of players
r=1
locate 1,c: print "player ";p; 'print the player number
r=r+2
for cn=1 to 13 'checks card numbers
for ca = 1 to 52/np 'for the number of cards that the player has
if chkcardsuit$(player$(p,ca)) = "Clubs" and chkcardval(player$(p,ca)) = cn then ' checks and sorts
locate r,c: print player$(p,ca) 'for clubs and number
r=r+1
end if
next
next
'checks for spades and numbers
for cn=1 to 13
for ca = 1 to 52/np
if chkcardsuit$(player$(p,ca)) = "Spades" and chkcardval(player$(p,ca))=cn then
locate r,c: print player$(p,ca)
r=r+1
end if
next
next
'checks for diamonds and numbers
for cn=1 to 13
for ca = 1 to 52/np
if chkcardsuit$(player$(p,ca)) = "Diamonds" and chkcardval(player$(p,ca))=cn then
locate r,c: print player$(p,ca)
r=r+1
end if
next
next
'checks for hearts and numbers
for cn=1 to 13
for ca = 1 to 52/np
if chkcardsuit$(player$(p,ca)) = "Hearts" and chkcardval(player$(p,ca))=cn then
locate r,c: print player$(p,ca)
r=r+1
end if
next
next
c=c+18 'moves colums over 18
next
do:loop until inkey$=chr$(27)
end
function rndcard$()
SS=int(rnd*4)+1 'this is selects the suit
card=int(rnd*13)+1 ' this selects the card number
'names the suits
select case SS
case 1
suit$="Spades"
case 2
suit$="Clubs"
case 3
suit$="Diamonds"
case 4
suit$="Hearts"
end select
'selects the card names
select case card
case 1
cname$="Ace"
case 11
cname$="Jack"
case 12
cname$="Queen"
case 13
cname$="King"
case else
cname$=str(card)
end select
rndcard$=cname$ + " of " + suit$ 'puts it all together
end function
function chkcardval(caval$)
cname$=left$(caval$,2)'gets leftmost 2 letters
'puts numbers to the card names
select case cname$
case "Ja"
cval=11
case "Qu"
cval=12
case "Ki"
cval=13
case "Ac"
cval=1
case else
cval=val(caval$)
end select
'returns the value
chkcardval=cval
end function
function chkcardsuit$(cname$)
'just chekcs the rightmost 2 letters and checks for the suit name
select case right$(cname$,2)
case "es"
chkcardsuit$="Spades"
case "bs"
chkcardsuit$="Clubs"
case "ds"
chkcardsuit$="Diamonds"
case "ts"
chkcardsuit$="Hearts"
case else
chkcardsuit$="Not a suit"
end select
end function