This is golf solitaire that runs as a text based console program. I choose to do it this way to be creative and unqic.It should work with most 32-bit versions of windows including windows 10.
ScreenShots:
unit golfsol1; //GolfSolitaire() is the main function interface uses graphics,windows,classes,sysutils,shellapi; const SCORES_SHOW_ONLY=126; SCORES_INIT=127; CurrentVersion=$01000000; procedure GolfSolitaire(params:tstringlist); implementation type TRandom=function(range:integer):integer;stdcall; TCard=record face,suit,deck,notused:byte; end; TGolfScore=record Name:shortstring; gametype:byte; score:shortint; end; TGolfGame=record gamenum:integer; decks:byte; cardcount:array[-1..9]of byte; drawpile:array[1..40]of pointer; discardpile:array[1..104]of pointer; end; PGolfScore=^TGolfScore; TGetConsoleWindow=Function:HWND;stdcall; var rand:hmodule=0; suits:array[1..4]of longint; drandom:TRandom; GetConsoleWindow:TGetConsoleWindow;//for compatiblity with older windows carddeck:array[1..4,1..14]of byte; tableua:array[-1..9]of tlist; hout:thandle; gameover,inGame:boolean; defattrib: word; currentscore:shortint; scores:array[0..9]of tgolfscore; hk:hkey; gamenum,intour:integer; lost,win,jokersused,aceking,decks,showdiscard,oldestver:dword; drawpile_bonus_points:Shortint; function AllUsedJokers:boolean; begin result:=(carddeck[1,14]=jokersused); end; procedure SaveGame; var sav:tgolfgame; i:integer; begin sav.gamenum:=gamenum; sav.decks:=decks; for i:=-1to 9do sav.cardcount[i]:=tableua[i].count; for i:=1to tableua[-1].count do sav.drawpile[i]:=tableua[-1][i-1]; for i:=1to tableua[0].count do sav.discardpile[i]:=tableua[0][i-1]; regsetvalueex(hk,'SavedGame',0,reg_binary,@sav,sizeof(sav)); end; function allused:boolean; var i,j:integer; begin result:=allusedjokers; for i:=1to 4do for j:=1to 13do result:=result and(carddeck[i,j]>=decks); end; function drawcard:pointer; var car:tcard; label shuffle; begin car.face:=16; car.suit:=5; result:=pointer(car); if allused then exit; shuffle:if jokersused>0then car.face:=drandom(14)+1 else car.face:=drandom(13)+1; car.suit:=drandom(4)+1; if(car.face=14) and (car.suit>1) then goto shuffle; if carddeck[car.suit,car.face]=decks then goto shuffle; inc(carddeck[car.suit,car.face]); car.deck:=carddeck[car.suit,car.face]; result:=pointer(car); end; procedure clearconsole; var co:coord; written:dword; begin co.x:=0; co.y:=0; setconsolecursorposition(hout,co); fillconsoleoutputcharacter(hout,#32,$ffff,co,written); setconsolecursorposition(hout,co); end; procedure Randominit(gamenum:integer); var i,j:integer; begin if decks=1then drawpile_bonus_points:=-(16+JokersUsed); if decks=2then drawpile_bonus_points:=-(40+jokersused); zeromemory(@carddeck,sizeof(carddeck)); if rand<>0then freelibrary(rand); zeromemory(@carddeck,sizeof(carddeck)); rand:=LoadLibrary('random32.dll'); @drandom:=getprocaddress(rand,'MyRandom'); if not assigned(drandom)then begin writeln('Could'#39't load random32.dll');readln; regclosekey(hk);exitprocess(0);end; for i:=0to gamenum do drandom(gamenum); setconsoletitle(pchar('Golf Solitaire #'+inttostr(gamenum))); if decks=1then for i:=1to 7do begin tableua[i].clear; for j:=1to 5do tableua[i].add(drawcard); end; if decks=2then for i:=1to 9do begin tableua[i].clear; for j:=1to 7do tableua[i].add(drawcard); end; tableua[0].clear; tableua[-1].clear; tableua[0].add(drawcard); while not allused do tableua[-1].add(drawcard); end; const background_white=background_red or background_green or background_blue or background_intensity; char_heart=#3; char_diamond=#4; char_club=#5; char_spade=#6; function cardtostring(card:tcard):string; var attrib:word; begin if lobyte(hiword(suits[card.suit]))=ord('R')then attrib:=foreground_red or foreground_intensity or background_white else attrib:=background_white; if card.suit=0then attrib:=0; setconsoletextattribute(hout, attrib); case card.face of 0,16:result:=#32; 1:result:='A'; 10:result:='T'; 11:result:='J'; 12:result:='Q'; 13:result:='K'; 14:begin result:='??';exit;end;//Joker else result:=inttostr(card.face);end; case card.suit of 1,2,3,4:result:=result+chr(hibyte(hiword(suits[card.suit]))); else result:=result+#32; end; end; function sortscores(Item1, Item2: pointer): Integer; begin if pgolfscore(item1).score<pgolfscore(item2).score then result:=-1; if pgolfscore(item1).score=pgolfscore(item2).score then result:=0; if pgolfscore(item1).score>pgolfscore(item2).score then result:=1; end; function ScoreStr(score:PGolfScore):string; begin result:=inttostr(score.score); if score.score=scores_init then result:='N/A'; end; function gametypetostr(gt:byte):string; begin result:=''; if gt and 1=1then result:='AceKing '; if gt and 2=2then result:=result+'2-decks'; end; procedure ShowScores(score:shortint); var cbscores:dword; I:integer; thisscore:TGolfScore; scorea:array[0..9]of tgolfscore; sortedscores:tlist; begin setconsoletextattribute(hout,defattrib); sortedscores:=tlist.Create; thisscore.gametype:=0; cbscores:=0; if(aceking=1)then thisscore.gametype:=1; if(decks=2)then thisscore.gametype:=thisscore.gametype or 2; if score<scores_show_only then begin write('Enter your name:');readln(thisscore.name); thisscore.score:=score;end; regqueryvalueex(hk,'Scores',nil,nil,nil,@cbscores); if cbscores=sizeof(scores)then regqueryvalueex(hk,'Scores',nil,nil,@scores,@cbscores); for i:=0to 9do sortedscores.Add(@scores[i]); if score<126then sortedscores.Add(@thisscore); sortedscores.Sort(sortscores); writeln('Place,Score,Name,GameType'); for i:=0to 9do begin write(i+1,'. ',scorestr(sortedscores[i]),' ',pgolfscore( sortedscores[i]).name,' ',gametypetostr(pgolfscore(sortedscores[i]).gametype)); if sortedscores[i]=@thisscore then write('<--');writeln;copymemory(@scorea[i], sortedscores[i],sizeof(tgolfscore)); end; copymemory(@scores,@scorea,sizeof(scorea)); regsetvalueex(hk,'Scores',0,reg_binary,@scores,sizeof(scores)); sortedscores.Free; writeln('Wins: ',win,' Lost: ',lost,' Games Played: ',win+lost); write('Press enter to return...');readln; clearconsole; end; procedure loadgame; var sav:tgolfgame; i,j,colcount:integer; cb:dword; Begin cb:=sizeof(sav); RegQueryValueEx(hk,'SavedGame',nil,nil,@sav,@cb); decks:=sav.decks; if decks=1 then colcount:=5 else colcount:=7; gamenum:=sav.gamenum; randominit(gamenum); for i:=1to 9do if tableua[i].count>0then for j:=1to colcount-sav.cardcount[i] do tableua[i].remove( tableua[i].last); tableua[0].clear;tableua[-1].clear; for i:=1 to sav.cardcount[-1] do tableua[-1].add(sav.drawpile[i]); for i:=1to sav.cardcount[0]do tableua[0].add(sav.discardpile[i]); end; procedure youwinproc; var conrect:trect; sortedscores:tlist; ywbmp:graphics.tbitmap; concan:tcanvas; begin ingame:=false; GetWindowRect(getconsolewindow,conrect); writeln('ÉÍÍÍÍÍÍÍÍÍÍ»'); writeln('º You win! º'); writeln('ÈÍÍÍÍÍÍÍÍÍͼ'); gameover:=true; @getconsolewindow:=GetProcAddress(getmodulehandle('kernel32.dll'), 'GetConsoleWindow'); if assigned(getconsolewindow)then if getconsolewindow<>0then begin ywbmp:=graphics.tbitmap.create; ywbmp.Handle:=loadbitmap(hinstance,'YOUWON'); Concan:=tcanvas.Create; concan.Handle:=GetWindowDC(getconsolewindow); concan.Draw((conrect.Right-ywbmp.width)div 2,(conrect.Bottom-ywbmp.height)div 2, ywbmp); releasedc(getconsolewindow,concan.handle); concan.Free; ywbmp.FreeImage; ywbmp.Free; end; showscores(drawpile_bonus_points); inc(win); regdeletevalue(hk,'SavedGame'); regsetvalueex(hk,'Win',0,reg_dword,@win,4); end; {$RESOURCE GOLFSOL32.RES} function quit(typ:dword):Bool;stdcall; var dwGame:dword; begin result:=true; dwGame:=gamenum; if ingame then savegame; regsetvalueex(hk,'Win',0,reg_dword,@win,4); regsetvalueex(hk,'Lost',0,reg_dword,@lost,4); regclosekey(hk); exitprocess(0); end; function ismove(pile1,pile2:tlist):boolean; var p1,p2:pointer; c1,c2:tcard; begin result:=false; if(pile1.Count*pile2.Count=0)then exit; p1:=pile1.last; p2:=pile2.last; copymemory(@c1,@p1,4); copymemory(@c2,@p2,4); result:=(abs(c1.face-c2.face)=1)or(c1.face=14)or(c2.face=14); if(((c1.face=1)and(c2.face=13))or((c1.face=13)and(c2.face=1)))and(aceking=1)then result:=true; end; function AnyMoreMoves:byte; var i:integer; begin result:=0; for i:=1to 9 do if ismove(tableua[0],tableua[i])then inc(result); end; procedure ShowRules; begin clearconsole; writeln('ÉÍÍÍÍÍÍÍÍÍÍ͹Golf RulesÌÍÍÍÍÍÍÍÍÍÍ»'); writeln('ºThe rules for golf solitaire are º'); writeln('ºvery simple. The whole idea of º'); writeln('ºgame is to get rid of all cards º'); writeln('ºin the seven columns(1 deck) or º'); writeln('ºnine columns(2 decks). As in º'); writeln('ºregular golf you want to get the º'); writeln('ºlowest points. When the game endsº'); writeln('ºwhatever cards are left count as º'); writeln('ºone point per card. If you go outº'); writeln('ºthe number of cards left will º'); writeln('ºbecome a negative points. You º'); writeln('ºwill try to move the cards from º'); writeln('ºthe columns to the discard pile. º'); writeln('ºThey must be one card bigger or º'); writeln('ºone card smaller.Example: a 5 canº'); writeln('ºbe moved to the discard pile onlyº'); writeln('ºif the top card is a 6 or a 4,theº'); writeln('ºsuit doesnt matter. You can choseº'); writeln('ºa column by entering the number 1º'); writeln('ºthough 9 and then pressng enter. º'); writeln('ºWhen there are no more moves you º'); writeln('ºcan type in 0 and hit enter or º'); writeln('ºtype in 10 and hit enter to go toº'); writeln('ºmenu. º'); writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ'); writeln('Press enter to return...'); readln; intour:=2; end; procedure Tour; begin clearconsole; writeln('ÉÍÍÍÍÍÍÍÍÍ͹Golf TourÌÍÍÍÍÍÍÍÍÍÍÍÍ»'); writeln('ºTo know how to use this game you º'); writeln('ºwill be entering in numbers to º'); writeln('ºtell the game your moves & what º'); writeln('ºyou want to do. The columns are º'); writeln('ºnumbered and so is the draw pile.º'); writeln('ºTo draw you enter in 0 and press º'); writeln('ºenter. Next we will look at the º'); writeln('ºrules. º'); writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ'); writeln('Press enter to continue...'); readln; intour:=1; end; procedure GolfSolitaire(params:tstringlist); var i,j,choice:integer; topcard:tcard; pc:pointer; cb,sgame:dword; label gamepmt,gameend,menu,trytour; begin hout:=getstdhandle(std_output_handle); defattrib:=foreground_intensity or foreground_red or foreground_blue or foreground_green; decks:=1; randomize; ingame:=false; setconsoleoutputcp(437); oldestver:=0; for i:=0to 9do begin scores[i].Name:='N/A';scores[i].score:=scores_init;end; SetConsoleCtrlHandler(@quit,true); regcreatekey(hkey_current_user,'Software\Justin\GolfSolitaire',hk); intour:=0; suits[1]:=makelong(ord('C'),makeword(ord('B'),ord(char_club))); suits[2]:=makelong(ord('S'),makeword(ord('B'),ord(char_spade))); suits[3]:=makelong(ord('H'),makeword(ord('R'),ord(char_heart))); suits[4]:=makelong(ord('D'),makeword(ord('R'),ord(char_diamond))); cb:=sizeof(suits); regqueryvalueex(hk,'Suit',nil,nil,@suits,@cb); regsetvalueex(hk,'Suit',0,reg_binary,@suits,sizeof(suits)); cb:=4;regqueryvalueex(hk,'Decks',nil,nil,@decks,@cb); if(decks=0)or(decks>2)then decks:=1; showdiscard:=0; cb:=4; lost:=0; win:=0; regqueryvalueex(hk,'Lost',nil,nil,@lost,@cb); cb:=4; gameover:=true; regqueryvalueex(hk,'Win',nil,nil,@win,@cb); cb:=4; aceking:=0;jokersused:=0;sgame:=0; //regqueryvalueex(hk,'JokersUsed',nil,nil,@jokersused,@cb); //Jokers for some reason freeze up the game being delt. regqueryvalueex(hk,'LastGame',nil,nil,@sgame,@cb); cb:=4; //if jokersused>2then jokersused:=0; regqueryvalueex(hk,'AceKing',nil,nil,@aceking,@cb); cb:=4; if aceking>1then aceking:=0; regqueryvalueex(hk,'ShowDiscard',nil,nil,@showdiscard,@cb); if showdiscard>1then showdiscard:=0; for i:=-1 to 9do tableua[i]:=tlist.create; if regqueryvalueex(hk,'OldestVersion',nil,nil,nil,nil)<>error_success then begin trytour: write('Would you like to take a tour? type in 1 for Yes or 0 for No:'); readln(choice); case choice of 1:tour; 0:goto menu; else goto trytour; end; oldestver:=currentversion; regsetvalueex(hk,'OldestVersion',0,reg_dword,@oldestver,4); if intour=1 then goto menu; end; menu:clearconsole; setconsoletextattribute(hout,defattrib); writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); writeln('ºWelcome to Golf Solitaire º'); writeln('ºWhat would you like to do? º'); writeln('º1. Start a new game º'); writeln('º2. Enter in a game number º'); writeln('º3. View top ten º'); cb:=4; writeln('º4. See game rules º'); writeln('º5. Change rules and settings º'); if ingame then writeln('º6. Return to game º'); if regqueryvalueex(hk,'SavedGame',nil,nil,nil,nil)=error_success then writeln('º7. Load Saved Game º'); writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ'); if intour=1 then writeln('To see rules type 4 and press enter'); write('Choice Number:');readln(choice); case choice of 4:begin showrules;goto menu;end; 1:begin gamenum:=random(maxint)+1; randominit(gamenum);end; 2:begin write('Enter game#:');readln(gamenum);randominit(gamenum);end; 3:begin showscores(scores_show_only);goto menu;end; 5:begin writeln('Current Settings:'); write('Aces can be played on kings: ');if aceking=1then writeln('Yes')else writeln('No');//writeln('Jokers used: ',jokersused); writeln('Number of card decks:',decks); write('Show all cards in the discard pile:'); if showdiscard=1then writeln('Yes')else writeln('No'); writeln('2=DontChange 1=Yes 0=No Any Other number returns to menu'); Write('Play Kings on Aces? Number Choice:');readln(aceking); if aceking>1then goto menu; {tryjoker: write('Number of jokers to use. 0 though 2 are valid numbers:'); readln(jokersused); if(JokersUsed>2)then begin Writeln('Too many jokers.');goto tryjoker;end; } write('Show all cards in the discard pile?(0=No 1=yes)');readln(showdiscard); regsetvalueex(hk,'ShowDiscard',0,reg_dword,@showdiscard,4); //regsetvalueex(hk,'JokersUsed',0,reg_dword,@jokersused,4); regsetvalueex(HK,'AceKing',0,reg_dword,@aceking,4); write('Enter number of decks to use(1 or 2):');readln(decks); regsetvalueex(hk,'Decks',0,reg_dword,@decks,4); goto menu; end; 6:if ingame then goto gamepmt else goto menu; 7:if RegQueryValueex(hk,'SavedGame',nil,nil,nil,nil)=error_success then loadgame else goto menu; else goto menu; end; gameover:=false; drawpile_bonus_points:=-tableua[-1].count; gamepmt: clearconsole; setconsoletextattribute(hout,defattrib); ingame:=true; write('Game#: ',gamenum,' Cards left:'); j:=0; for i:=1to 9do j:=j+tableua[i].count; write(j,' Draws left:',tableua[-1].count,' Type in 10 for menu'); writeln; writeln('[1][2][3][4][5][6][7][8][9]'); if decks=1 then for i:=0to 4do begin write(' '); for j:=1to 9do begin if tableua[j].count>i then write(cardtostring(tcard(tableua[j][i]))) else write(' ');write(' ');end; writeln; end; if decks=2 then for i:=0to 6do begin write(' '); for j:=1to 9do begin if tableua[j].count>i then write(cardtostring(tcard(tableua[j][i]))) else write(' ');write(' ');end; writeln; end; setconsoletextattribute(hout,defattrib); pc:=tableua[0].last; copymemory(@topcard,@pc,4); write('Draw[0]: '); if showdiscard=0then write(cardtostring(topcard)) else for i:=0to tableua[0].count-1do begin pc:=tableua[0][i];copymemory(@topcard, @pc,4);write(cardtostring(topcard));end; writeln; setconsoletextattribute(hout,defattrib); write('Choice:'); readln(choice); case choice of 1,2,3,4,5,6,7,8,9:if ismove(tableua[0],tableua[choice])then begin tableua[0].add(tableua[choice].last);tableua[choice].remove( tableua[choice].last);if(tableua[-1].count=0) and(anymoremoves=0) then goto gameend; end; 0:begin if((tableua[-1].count=0) and(anymoremoves=0)) then goto gameend;tableua[0].add(tableua[-1].last);inc(drawpile_bonus_points); tableua[-1].remove(tableua[-1].last); end; 10:goto menu; end; if(tableua[1].count+tableua[2].count+tableua[3].count+tableua[4].count+ tableua[5].count+tableua[6].count+tableua[7].count+tableua[8].count+ tableua[9].count=0)then begin youwinproc; goto menu; end; goto gamepmt; gameend: regdeletevalue(hk,'SavedGame'); Writeln('Sorry, no more moves'); writeln('Tableua points: ',tableua[1].count+tableua[2].count+tableua[3].count+ tableua[4].count+tableua[5].count+tableua[6].count+tableua[7].count+ tableua[8].count+tableua[9].count); gameover:=true; inc(lost); ingame:=false; regsetvalueex(hk,'Lost',0,reg_dword,@lost,4); showscores(tableua[1].count+tableua[2].count+tableua[3].count+tableua[4].count+ tableua[5].count+tableua[6].count+tableua[7].count); //writeln('Press enter to return...');readln; goto menu; end; end.