Older Version
Newer Version
Alyce
Jul 16, 2011
=Patience=
//by JohnnyD//
Hi all, Here's my solitaire game. QCARD32.DLL is required in the LB folder
The object of this game is to place cards in pairs over existing cards such that the value of each pair of covered cards adds up to eleven.
(e.g. 6 & 5, 7 & 4, Jack & Ace, etc)
Suits are irrelevant. Ace counts as one, picture cards count as ten.
A Jack-Queen-King sequence is also permitted.
[[code format="lb"]]
nomainwin
dim saved(3,4):dim deck(52,2):dim pos(9,4)
for a=0 to 3
for b= 1 to 13
deck(a*13+b,1)=a*13+b:deck(a*13+b,2)=b
next b
next a
restore[posn]
for a= 1 to 9
read b,c:pos(a,1)=b:pos(a,2)=c
next a
[posn]
data 10,2,110,2,210,2,10,102,110,102,210,102,10,202,110,202,210,202
WindowWidth=306:WindowHeight=382
UpperLeftX=(DisplayWidth-WindowWidth)/2
UpperLeftY=(DisplayHeight-WindowHeight)/2
menu #1,"&Options","&Deal",[deal],"&Help",[help],"E&xit",[quit]
graphicbox #1.g,0,0,300,330
open "Patience" for window_nf as #1
#1 "trapclose [quit]"
#1.g "setfocus; when leftButtonUp [checkIndex]"
hBox=hwnd(#1.g)
open "qcard32.dll" for dll as #qc
calldll #qc,"InitializeDeck",hBox as long,r as long
[deal]
dealt=0:clicks=0:card=0:score=0:pic=0
reclaim=0:dim jqk(3):nomore=0
calldll #qc,"SetDefaultValues",r as void
gosub[shuffle]
#1.g "down; fill 10 190 225"
#1.g "backcolor 10 190 225"
for i=1 to 9
Call DealCard hBox,deck(i,1),pos(i,1),pos(i,2)
pos(i,3)=deck(i,1):pos(i,4)=deck(i,2)
dealt=dealt+1
next i
gosub[moretest]
[wait]
#1.g "place 10 320"
#1.g "\Cards Left:";52-dealt;" "
if nomore=1 then
confirm "Play Again?";q$
if q$="yes" then
goto[deal]
else
goto[quit]
end if
end if
wait
[checkIndex]
x=MouseX:y=MouseY
for a= 1 to 9
if (x>pos(a,1)) and (x<pos(a,1)+70) and (y>pos(a,2)) and (y<pos(a,2)+95) then exit for
next a
card=a
if a=10 then
card=0:goto[wait]
end if
dealt=dealt+1
#1.g "place 80 320":#1.g "\";52-dealt;" "
clicks=clicks+1
if pos(card,4)>10 then
score=score+10
else
score=score+pos(card,4)
end if
saved(clicks,1)=card:saved(clicks,2)=pos(card,3):saved(clicks,3)=pos(card,4)
Call DealCard hBox,deck(dealt,1),pos(card,1),pos(card,2)
if pos(card,4)<11 then[2pictest]
pic=pic+1
if jqk(pos(card,4)-10)=pos(card,4) then[gotpic]
jqk(pos(card,4)-10)=pos(card,4)
pos(card,3)=deck(dealt,1):pos(card,4)=deck(dealt,2)
if pic=3 then[zeroscore]
goto[2clicktest]
[gotpic]
select case pos(card,4)
case 11
name$="J"
case 12
name$="Q"
case 13
name$="K"
end select
notice "Already Have a ";name$;"!":dim jqk(3)
[redeal]
reclaim=clicks:gosub[redealold]
[zeroscore]
score=0:pic=0:clicks=0:reclaim=0:dim jqk(3)
gosub[moretest]
goto[dealtall]
[2pictest]
if pic=2 then
notice "Can't Have ";pos(card,4);" in J-Q-K Run!"
dim jqk(3)
goto[redeal]
end if
[2clicktest]
pos(card,3)=deck(dealt,1):pos(card,4)=deck(dealt,2)
if pic>1 then[dealtall]
if clicks=2 then
reclaim=clicks:clicks=0
if score <> 11 then
dim name$(2)
for a= 1 to 2
name$(a)=str$(saved(a,3))
select case name$(a)
case "1"
name$(a)="A"
case "11"
name$(a)="J"
case "12"
name$(a)="Q"
case "13"
name$(a)="K"
end select
next a
notice name$(1)+" and "+name$(2)+" is not 11!"
gosub[redealold]
else
score=0:reclaim=0:pic=0:dim jqk(3)
gosub[moretest]
end if
end if
[dealtall]
if dealt=52 then
confirm "You Did it! Play Again?";q$
if q$="yes" then [deal] else [quit]
end if
goto[wait]
[shuffle]
for a=1 to 500
b=int(rnd(0)*52)+1:c=int(rnd(0)*52)+1
d=deck(b,1):dd=deck(b,2)
deck(b,1)=deck(c,1):deck(b,2)=deck(c,2)
deck(c,1)=d:deck(c,2)=dd
next a
return
[redealold]
for a=1 to reclaim
Call DealCard hBox,saved(a,2),pos(saved(a,1),1),pos(saved(a,1),2)
pos(saved(a,1),3)=saved(a,2):pos(saved(a,1),4)=saved(a,3)
next a
dealt=dealt-reclaim:score=0:reclaim=0:pic=0:dim jqk(3)
return
[quit]
close #qc:close #1:end
[moretest]
more=0:nomore=0
for a= 1 to 8
for b=a+1 to 9
if pos(a,4)+pos(b,4)=11 then more=1
next b
next a
jqk=0
for a=1 to 9
if pos(a,4)>10 then jqk=1
next a
for a= 1 to 9
if pos(a,4)=1 and jqk=1 then more=1
next a
dim jqktest(3)
for a=1 to 9
if pos(a,4)>10 then jqktest(pos(a,4)-10)=1
next a
if jqktest(1)=1 and jqktest(2)=1 and jqktest(3)=1 then more=1
if more=0 then nomore=1: notice "No More Moves"
return
[help]
help$="Help"+chr$(13)
help$=help$+"The object of the game is place pairs of cards on"+chr$(13)
help$=help$+"existing cards such that each pair of covered cards"+chr$(13)
help$=help$+"adds up to eleven, until the pack is used up."+chr$(13)+chr$(13)
help$=help$+"Suit is irrelevant, Ace counts as one,"+chr$(13)
help$=help$+"picture cards count as ten."+chr$(13)
help$=help$+"Example moves are 6 & 5, 8 & 3, Jack & Ace, etc."+chr$(13)+chr$(13)
help$=help$+"A Jack - Queen - King run is also permitted."+chr$(13)
help$=help$+"Incorrrect moves will be indicated and the deck will back up."
notice help$
wait
Sub DealCard hndle,nC,x,y
calldll #qc,"DealCard",hndle as long,nC as long,x as long,y as long,r as void
End Sub
[[code]]