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 dimsaved(3,4), deck(52,2),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] fora=1a= 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,202WindowWidth=310:WindowHeight=380:UpperLeftX=1:UpperLeftY=25WindowWidth=306:WindowHeight=382 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 menu#1,"&Options","&Deal",[deal],"E&xit",[quit]#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:dimdealt=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 "PlayAgain?";q$: ifAgain?";q$ if q$="yes"then[deal] else[quit]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 acard=a:ifcard=a if a=10 thencard=0:goto[wait]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:dimjqk(3):gosub[moretest]:goto[dealtall]jqk(3) gosub[moretest] goto[dealtall] [2pictest] if pic=2 thennoticenotice "Can't Have ";pos(card,4);" in J-Q-KRun!":dim jqk(3):goto[redeal]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 not11!":gosub[redealold]11!" gosub[redealold] else score=0:reclaim=0:pic=0:dimjqk(3):gosub[moretest]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:dimjqk(3):returnjqk(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 ajqk=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 adim 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]]