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.
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
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.
Root
Back
Forward
Go to parent folder
Reload
Mount network volume
New folder
New file
Upload files
Open
Download
Select files
Undo
Redo
Copy
Cut
Paste
Delete
Empty the folder
Duplicate
Rename
Edit file
Resize & Rotate
Change mode
Select all
Select none
Invert selection
Preview
Get info
Extract files from archive
Create archive
View
Sort
About this software
Full Screen
Trash
by name
by size
by kind
by date
by permission
by mode
by owner
by group
Folders first
Also Treeview
Error
Unable to connect to backend. HTTP error 0
All programs are virus free. Some antivirus software might say its "suspicious" or a "Potentionaly Unwanted Program". Some of them rate them on what there code looks like no matter if theres a definition in the virus database. If any of them are detected any Antivirus I will zip the software with the password "justin" j is lowercase
Published by Justin Roeder
I am an electronics engineer and computer programmer that has autism. I learned by myself
View more posts
delphijustin Industries is an Autism Supported Business