Aces Up Solitaire

Try out this solitaire game. This solitaire game is fun and addictive. For rules of this game, click here. It also saves games, tells you when there are no more moves,when aces are covering each piles and custom card decks. Just run the exe file to play

unit acesupUnit1;
//Main unit
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, mmsystem,
  ExtCtrls, Menus,shellapi,dialogs, StdCtrls,math;

{$RESOURCE acesup32.res}
const ticktocksound='TICKTOCK';
CARD_RESERVED_SIZE=Sizeof(pointer)-2;
gamename='Aces Up';
DELPHIJUSTIN_KEY='Software\Justin';
GAMESPATH='GamesPath';
GameStats='ScoreStats';
NoHintsDescription='Delete this vaue to enable move hints.';
nohints='NoHints';
ShellFoldersName='SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
bad_game_data_error='Saved game is invalid.';
GAME_KEY_NAME='Software\Justin\AcesUp';
CurrentVersion='CurrentVersion';
gamever=$01000000;
savename='Settings\AcesUp.sav';
valid_save_size=4+6+(2*52);
CardValues:array[0..12]of byte=(13,1,2,3,4,5,6,7,8,9,10,11,12);
Faces:array[0..12]of string=('Ace','Two','Three','Four','Five','Six','Seven',
'Eight','Nine','Ten','Jack','Queen','King');
Suits:array[1..4]of string=('Clubs','Diamonds','Hearts','Spades');
WinnerScore=52-4;
type
  TAcesUpTable = class(TForm)
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    PaintBox3: TPaintBox;
    PaintBox4: TPaintBox;
    PaintBox5: TPaintBox;
    PaintBox6: TPaintBox;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Game1: TMenuItem;
    NewGame1: TMenuItem;
    EnterGameNumber1: TMenuItem;
    Exit1: TMenuItem;
    ChangeCardDeck1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    HowToPlay1: TMenuItem;
    Label1: TLabel;
    NoHints1: TMenuItem;
    HowToUseThisGame1: TMenuItem;
    HighScores1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure HowToPlay1Click(Sender: TObject);
    procedure NewGame1Click(Sender: TObject);
    procedure EnterGameNumber1Click(Sender: TObject);
    procedure ChangeCardDeck1Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure Exit1Click(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure NoHints1Click(Sender: TObject);
    procedure HowToUseThisGame1Click(Sender: TObject);
    procedure HighScores1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
TPlayingCard=record
face,suit:byte;
reserved:array[1..CARD_RESERVED_SIZE]of byte;
end;
TScoreStats=record
GamesPlayed,Gameswon:extended;
end;
{$RESOURCE D:\CARDDECK.RES}

var gamenum:integer;
  hdeck:hmodule;
  back:dword;
  bBack,EmptyPile,EmptyDrawPile:tbitmap;
  deck_pics:array[0..12,1..4]of tbitmap;
  AcesUpTable: TAcesUpTable;
  piles:array[0..5]of tlist;
  used:array[0..12,1..4]of boolean;
implementation
uses acesupunit2;
{$R *.DFM}

function VersionStr:string;
begin
result:=format('%x.%x.%x.%x',[hibyte(hiword(gamever)),lobyte(hiword(gamever)),
Hibyte(loword(gamever)),lobyte(loword(gamever))]);
end;

function acesUnder(index:byte):byte;
var i:integer;
pcar:pointer;
card:tplayingcard;
begin
result:=0;zeromemory(@card,sizeof(card));
for i:=1to 4do begin card.suit:=i;copymemory(@pcar,@card,sizeof(card));if piles[
index].indexof(pcar)>-1then inc(result);end;
end;

function acesCovering:boolean;
var i,j:integer;
pcar:pointer;
card:tplayingcard;
pilecount:array[0..6]of byte;
begin
zeromemory(@pilecount,sizeof(pilecount));
pcar:=nil;zeromemory(@Card,Sizeof(card));for i:=1to 4do for j:=0to 3do begin
card.suit:=i;copymemory(@pcar,@card,sizeof(card));
if(piles[j].indexof(pcar)>0)then begin inc(pilecount[j]);inc(pilecount[4]); end
else begin if(piles[j].indexof(pcar)=0)and(acesunder(j)=1)then inc(pilecount[5]);
pilecount[6]:=max(pilecount[6],acesunder(j));
end;end;
result:=(pilecount[4]=4);
for i:=0to 3 do result:=result and(pilecount[i]=1);
if not result then
result:=((pilecount[4]=1)and(pilecount[5]=3))or((pilecount[4]=2)and(pilecount[5]
=2)and(pilecount[6]=1));
end;

function CardBack:byte;
var rs,rtyp:Dword;
hk:hkey;
begin
RegCreateKey(hkey_current_user,GAME_KEY_NAME,hk);
back:=255;
rs:=4;
regqueryvalueex(hk,'CardBack',nil,@rtyp,@back,@rs);
result:=back;
regclosekey(hk);
if back>11then back:=strtointdef(paramstr(5),random(12));
end;

function HasMoves(index:byte):boolean;
var i:integer;
pc:pointer;
car1,car2:tplayingcard;
begin
result:=false;
if piles[index].count=0then exit;
pc:=piles[index].last;copymemory(@car1,@pc,sizeof(pc));
for i:=0to 3do if piles[i].count>0then begin pc:=piles[i].last;copymemory(@car2,
@Pc,sizeof(pc));result:=result or((cardvalues[car1.face]<cardvalues[car2.face])
and(car1.suit=car2.suit));end;
end;

function movesleft:boolean;
var i:integer;
suitcount:array[1..4]of byte;
pcar:pointer;
car:tplayingcard;
begin
zeromemory(@suitcount,4);
result:=false;
for i:=0to 3do if piles[i].count>0then begin pcar:=piles[i].last;copymemory(@car,
@pcar,sizeof(car));inc(suitcount[car.suit]);end;
for i:=1to 4do result:=result or(suitcount[i]>1);
acesuptable.Label1.Visible:=result;
end;

function EmptyPiles:boolean;
var i:integer;
begin
result:=false;
for i:=0to 3do result:=result or(piles[i].count=0);
end;

function CustomMsgBox(hw:hwnd;text,caption:pchar;flags,iconint:integer):integer;
var mbparams:msgboxparams;
begin
zeromemory(@mbparams,sizeof(mbparams));
mbparams.cbSize:=sizeof(mbparams);
mbparams.hwndOwner:=hw;
mbparams.hInstance:=hinstance;
mbparams.lpszText:=text;
mbparams.lpszCaption:=caption;
mbparams.dwStyle:=flags or mb_usericon;
mbparams.lpszIcon:=makeintresource(iconint);
result:=integer(messageboxindirect(mbparams));
end;

function checkForLost:boolean;
var mbtext:array[0..1024]of char;
hk:hkey;
rs:dword;
i:integer;
stats:tscorestats;
begin
result:=(not movesleft)and(piles[4].count=0)and(piles[5].count<winnerscore)and
(not emptypiles);
if result then begin deletefile(savename);regcreatekey(hkey_current_user,
game_key_name,hk);zeromemory(@stats,sizeof(stats));rs:=sizeof(stats);
regqueryvalueex(hk,GameStats,nil,nil,@stats,@rs);stats.GamesPlayed:=
stats.GamesPlayed+1;
regsetvalueex(hk,gamestats,0,reg_binary,@stats,sizeof(stats));
regclosekey(hk);
playsound('LOSE',hinstance,snd_resource or snd_sync);playsound(ticktocksound,
hinstance,snd_resource or snd_async or snd_loop);
if custommsgbox(acesuptable.Handle,strfmt(mbtext,
'Sorry, there are no more moves.'#13#10'Score: %d/%d'#13#10'Play again?',[piles[
5].count,winnerscore]),'Game Over',mb_yesno,253)=idyes then
acesuptable.NewGame1.Click;playsound(nil,0,0);
end;
acesuptable.PaintBox1.Enabled:=not result;
acesuptable.PaintBox2.Enabled:=not result;
acesuptable.PaintBox3.Enabled:=not result;
acesuptable.PaintBox4.Enabled:=not result;
end;

function drawcard:tplayingcard;
label newcard;
begin
zeromemory(@result,sizeof(result));
newcard:
result.suit:=Random(4)+1;
result.face:=random(13);
if used[result.face,result.suit] then goto newcard;
used[result.face,result.suit]:=true;
end;

procedure NewGame(game:integer);
var i:integer;
begin
acesuptable.Caption:='Aces Up Solitaire #'+inttostr(game);application.Title:=
acesuptable.Caption;
randseed:=game;
gamenum:=game;
for i:=0to 5 do piles[i].clear;
zeromemory(@used,sizeof(@used));
for i:=0to 51do
piles[4].Add(pointer(drawcard));
for i:=0to 3 do begin piles[i].add(piles[4].last);piles[4].remove(piles[4].last);
 end;
 acesuptable.FormPaint(nil);
end;

function pccard(i,j:integer):string;
begin
result:=format('CARD%d%x',[j,i]);
end;

function pcback(index:integer):string;
begin
result:=format('BACK%d',[index]);
end;

procedure savegame;
var cardcount:byte;
card:pointer;
i,j:integer;
hsavfile:thandle;
bWritten:dword;
begin
hsavfile:=createfile(savename,generic_write,file_share_read,nil,create_Always,
file_attribute_normal,0);
writefile(hsavfile,gamenum,sizeof(gamenum),bwritten,nil);
for i:=0to 5 do
begin
cardcount:=piles[i].count;writefile(hsavfile,cardcount,1,bwritten,nil);
for j:=0to cardcount-1do begin card:=piles[i][j];writefile(hsavfile,card,2,
bwritten,nil); end;
end;
closehandle(hsavfile);
end;

function opensavedgame:boolean;
var cardcount:byte;
card:pointer;
noload:boolean;
i,j,k:integer;
hsavfile:thandle;
bRead:dword;
car:tplayingcard;
begin
hsavfile:=createfile(savename,generic_read,file_share_read,nil,open_existing,
file_attribute_normal,0);
noload:=false;
result:=(hsavfile<>invalid_handle_value);
if result then begin if(not noload)and(valid_save_size<>getfilesize(hsavfile,nil))
then begin closehandle(hsavfile);
result:=false;messagebox(acesuptable.Handle,bad_game_data_error,gamename,
mb_iconerror);for i:=0to 5do piles[i].Clear;end;end;
if not result then begin closehandle(hsavfile);exit;end;
readfile(hsavfile,gamenum,sizeof(gamenum),bread,nil);
acesuptable.Caption := 'Aces Up Solitaire #'+inttostr(gamenum);
application.Title:=acesuptable.Caption;
for i:=0to 5 do begin
readfile(hsavfile,cardcount,1,bread,nil);
for j:=1to cardcount do begin card:=nil;readfile(hsavfile,card,2,bread,nil);
piles[i].add(card);copymemory(@car,@card,sizeof(car));if(car.suit=0)or(car.Face>12)or(
cardcount>52)or(car.suit>4)then begin result:=false;for k:=0to 5do
piles[k].clear;closehandle(hsavfile);messagebox(acesuptable.handle,
bad_game_data_error,gamename,mb_iconerror);exit;end;end;end;
result:=result and(piles[5].count<=Winnerscore);
if not result then begin messagebox(acesuptable.handle,bad_game_data_error,
gamename,mb_iconerror);for i:=0to 5do piles[i].clear;end;
closehandle(hsavfile);
end;

function IsLastestVersion(Ver:dword):boolean;
begin
result:=(ver<=gamever)and(ver>0);
end;

procedure displayHelp;
var mbText:array[0..1024]of char;
begin
messagebox(acesuptable.Handle,strpcopy(mbtext,
'To discard a card use the left mouse button.'#13#10+
'To move a card to an empty pile use the right mouse button.'#13#10+
'To see a covered card hold down the Ctrl key while clicking on the card.'#13#10+
'You can use the space key to draw.'#13#10+
'You can use lowercase a through d keys to discard from pile a through d'#13#10+
'You can use uppercase A through D keys to move a card to an empty pile'
),gamename,0);
end;

procedure TAcesUpTable.FormCreate(Sender: TObject);
var i,j:integer;
hkdj,hk,hkdirs:hkey;
rs,regver:dword;
deckdll,desktop,iconpath:array[0..max_path]of char;
begin
paintbox1.Canvas.Brush.Color:=clgreen;
paintbox2.Canvas.Brush.Color:=clgreen;
paintbox3.Canvas.Brush.Color:=clgreen;
paintbox4.Canvas.Brush.Color:=clgreen;
paintbox5.Canvas.Brush.Color:=clgreen;
paintbox6.Canvas.Brush.Color:=clgreen;
for i:=0to 12do for j:=1to 4do deck_pics[i,j]:=tbitmap.create;
for i:=0to 5do piles[i]:=tlist.Create;
randomize;
regcreatekey(hkey_current_User,GAME_KEY_NAME,hk);
nohints1.Checked:=(regqueryvalueex(hk,nohints,nil,nil,nil,nil)=error_success);
regver:=0;rs:=4;
regqueryvalueex(hk,CurrentVersion,nil,nil,@rs,@regver);
regcreatekey(hkey_current_user,delphijustin_key,hkdj);
if not islastestversion(regver) then begin
regver:=gamever;
displayhelp;
regsetvalueex(hk,CurrentVersion,0,reg_dword,@regver,4);
if messagebox(handle,'Create a icon onto the desktop?',gamename,mb_iconquestion
or mb_yesno)=idyes then begin regopenkey(hkey_current_user,shellfoldersname,
hkdirs);rs:=sizeof(desktop);regqueryvalueex(hkdirs,'Desktop',nil,nil,@desktop,
@rs);regclosekey(hkdirs);createdirectory(strfmt(iconpath,'%s\Delphijustin Games',
[desktop]),nil);regsetvalueex(hkdj,GamesPath,0,reg_sz,@iconpath,(1+strlen(
iconpath))*sizeof(char));
if copyfile(pchar(paramstr(0)),strfmt(iconpath,'%s\Delphijustin Games\AcesUp.exe',
[desktop]),false)then messagebox(handle,
'Program is under the "Delphijustin Games" folder on the Desktop.',gamename,
mb_iconinformation) else messagebox(handle,'Failed to create icon on Desktop',
gamename,mb_iconwarning);
end;
end;
rs:=sizeof(iconpath);
if regqueryvalueex(hkdj,gamespath,nil,nil,@iconpath,@rs)=error_success then
setcurrentdirectory(iconpath);
createdirectory('Settings',nil);
if regqueryvalueex(hk,'DeckDLL',nil,nil,@deckdll,@rs)=error_success then
hdeck:=loadlibrary(deckdll)else hdeck:=hinstance;cardback;
if(paramcount=0)or(paramstr(1)='/')then
if not opensavedgame then
newgame(random(maxint));
if(paramcount=1)and(paramstr(1)<>'/')then newgame(strtoint(paramstr(1)));
label1.Visible:=movesleft;
emptypile:=tbitmap.Create;
emptypile.LoadFromResourceName(hdeck,'CARD02');bBack:=tbitmap.Create;
bback.LoadFromResourceName(hdeck,pcback(back));
emptyDRAWpile:=tbitmap.Create;emptydrawpile.LoadFromResourceName(hdeck,'CARD01');
for i:=0to 12do for j:=1to 4do deck_pics[i,j].loadfromresourcename(hdeck,pccard(
i,j));
regclosekey(hkdj);
regclosekey(hk);
if fileexists(custom_card_back)then bback.LoadFromFile(custom_card_back);
end;

procedure TAcesUpTable.FormPaint(Sender: TObject);
var i,j:integer;
paintbox:tpaintbox;
car:tplayingcard;
pcar:pointer;
begin
paintbox1.Canvas.FillRect(rect(0,0,paintbox1.width,paintbox1.height));
paintbox2.Canvas.FillRect(rect(0,0,paintbox2.width,paintbox2.height));
paintbox3.Canvas.FillRect(rect(0,0,paintbox3.width,paintbox3.height));
paintbox4.Canvas.FillRect(rect(0,0,paintbox4.width,paintbox4.height));
paintbox5.Canvas.FillRect(rect(0,0,paintbox5.width,paintbox5.height));
paintbox6.Canvas.FillRect(rect(0,0,paintbox6.width,paintbox6.height));
paintbox1.Canvas.Draw(0,0,emptypile);
paintbox2.Canvas.Draw(0,0,emptypile);
paintbox3.Canvas.Draw(0,0,emptypile);
paintbox4.Canvas.Draw(0,0,emptypile);
for i:=0to 3 do begin case i of
0:paintbox:=paintbox1;
1:paintbox:=paintbox2;
2:paintbox:=paintbox3;
3:paintbox:=paintbox4;
end;
for j:=0to piles[i].count-1do begin pcar:=piles[i][j];copymemory(@car,@pcar,
sizeof(car));
paintbox.Canvas.Draw(0,j*16,deck_pics[car.face,car.suit]);end;
end;
paintbox5.Canvas.Draw(0,0,emptydrawpile);for i:=0to piles[4].count-1do
paintbox5.Canvas.Draw(0,i*8,bback);
for i:=0to piles[5].count-1do begin pcar:=piles[5][i];copymemory(@car,@pcar,
sizeof(car));
paintbox6.Canvas.Draw(i*16,0,deck_pics[car.face,car.suit]);
end;
end;

procedure Discard(PB:TPaintbox);
var b:boolean;
i:integer;
pcar:pointer;
car1,car2:tplayingcard;
begin
b:=false;
if piles[pb.Tag].count=0then exit;
pcar:=piles[pb.tag].last;copymemory(@car2,@pcar,sizeof(car1));
for i:=0to 3do if piles[i].count>0then begin pcar:=piles[i].last;copymemory(@car1,
@pcar,sizeof(car1));b:=b or((cardvalues[car1.face]>cardvalues[car2.face])and
(car1.suit=car2.suit));end;
if b then begin copymemory(@pcar,@car2,sizeof(car2));piles[pb.tag].remove(piles[
pb.tag].last);
piles[5].add(pcar);end;
end;

procedure MoveToEmpty(pb:tpaintbox);
var car:tplayingcard;
pcar:pointer;
i:integer;
begin
if piles[pb.tag].count=0then exit;
pcar:=piles[pb.tag].last;copymemory(@car,@pcar,sizeof(car));
for i:=pb.tag to 3 do if piles[i].count=0 then begin
piles[i].add(pcar);piles[pb.tag].remove(piles[pb.tag].last);exit;
end;
for i:=0 to 3do if piles[i].count=0 then begin
piles[i].add(pcar);piles[pb.tag].remove(piles[pb.tag].last);exit;end;
end;

procedure TAcesUpTable.PaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var car:tplayingcard;
pcar:pointer;
hk:hkey;
mbtext:array[0..255]of char;
gameover:boolean;
rs:dword;
stats:tscorestats;
begin
if piles[tpaintbox(sender).tag].count=0then exit;
if ssCtrl in shift then begin
if (y div 16)>=piles[TPaintbox(sender).tag].count then pcar:=piles[tpaintbox(
sender).tag].last else pcar:=piles[tpaintbox(sender).tag][y div 16];copymemory(
@car,@pcar,sizeof(car));
messagebox(handle,strfmt(mbtext,'That card is The %s Of %s',[faces[car.face],
suits[car.suit]]),gamename,mb_iconinformation);exit;
end;
label1.Visible:=movesleft;
if not paintbox1.Enabled then exit;
case button of
mbLeft:discard(tpaintbox(sender));
mbRight:MoveToEmpty(tpaintbox(sender));
end;
paintbox1mousemove(sender,[],0,0);
formpaint(nil);
gameover:=checkforlost or(piles[5].count=winnerscore);
acesuptable.PaintBox1.Enabled:=not gameover;
acesuptable.PaintBox2.Enabled:=not gameover;
acesuptable.PaintBox3.Enabled:=not gameover;
acesuptable.PaintBox4.Enabled:=not gameover;
if piles[5].count=WinnerScore then begin zeromemory(@stats,sizeof(stats));
regcreatekey(hkey_current_user,game_key_name,hk);rs:=sizeof(stats);
regqueryvalueex(hk,gamestats,nil,nil,@stats,@rs);
stats.GamesPlayed:=stats.GamesPlayed+1;
stats.Gameswon:=int(stats.Gameswon)+1;regsetvalueex(hk,gamestats,0,reg_binary,
@stats,sizeof(stats));
playsound('WINNER',hinstance,snd_sync or  snd_resource);
playsound(TickTockSound,hinstance,snd_resource or snd_async or snd_loop);
if custommsgbox(handle,strpcopy(mbtext,
'Congradulations, you won!'#13#10+
'Play Again?'),gamename,mb_yesno,254)=idyes then newgame1.Click;playsound(nil,0,0);
timer1.enabled:=true;exit;end;
if gameover then begin deletefile(savename);exit;end;
savegame;
end;

procedure TAcesUpTable.PaintBox5Click(Sender: TObject);
var i:integer;
hk:hkey;
rs:dword;
stats:tscorestats;
mbtext:array[0..1024]of char;
begin
if piles[4].count=0then exit;
for i:=0to 3 do begin piles[i].add(piles[4].last);piles[4].remove(piles[4].last);
end;
formpaint(nil);
if acescovering then begin playsound(ticktocksound,hinstance,snd_resource or
snd_async or snd_loop);if custommsgbox(handle,strfmt(mbtext,
'Aces are covering all piles making it impossible to win.'#13#10'Score %d/%d'#13#10'Continue playing?',
[piles[5].count,winnerscore]),gamename,mb_yesno,253)=idno then begin deletefile(
savename);zeromemory(@stats,sizeof(stats));regcreatekey(hkey_current_user,
game_key_name,hk);regqueryvalueex(hk,gamestats,nil,nil,
@stats,@rs);stats.GamesPlayed:=stats.GamesPlayed+1;regsetvalueex(hk,gamestats,0,
reg_binary,@stats,sizeof(stats));regclosekey(hk);
newgame1.Click;end;playsound(nil,0,0); end;
if checkforlost then begin deletefile(savename);exit;end;
savegame;
end;

procedure TAcesUpTable.Timer1Timer(Sender: TObject);
begin
canvas.Draw(random(width),random(height),deck_pics[random(13),random(4)+1]);
end;

procedure TAcesUpTable.About1Click(Sender: TObject);
var mbdata:msgboxparams;
begin
zeromemory(@mbdata,sizeof(mbdata));
mbdata.cbSize:=sizeof(mbdata);
mbdata.hwndOwner:=handle;
mbdata.hInstance:=hinstance;
mbdata.lpszText:=Strlfmt(stralloc(1024),1024,pchar(
'delphijustin Aces Up Solitaire v%s'#13#10+
'By Justin Roeder'#13#10+
'https://delphijustin.biz/'),[VersionStr]);
mbdata.lpszCaption:='About Aces Up';
mbdata.dwStyle:=mb_usericon;
mbdata.lpszIcon:=makeintresource(255);
messageboxindirect(mbdata);
strdispose(mbdata.lpszText);
end;

procedure TAcesUpTable.HowToPlay1Click(Sender: TObject);
begin
shellexecute(0,nil,'https://www.wikihow.com/Play-Aces-Up',nil,nil,sw_show);
end;

procedure TAcesUpTable.NewGame1Click(Sender: TObject);
begin
randomize;
shellexecute(0,nil,pchar(paramstr(0)),strpcopy(stralloc(15),inttostr(random(maxint))),
nil,sw_show);
exitprocess(0);
end;

procedure TAcesUpTable.EnterGameNumber1Click(Sender: TObject);
var gamenum:string;
i:integer;
begin
randomize;
gamenum:=inttostr(random(maxint));
if not inputquery('New Game','Enter game#',gamenum)then exit;
gamenum:=trim(gamenum);for i:=1to length(gamenum)do
if not(gamenum[i] in ['0'..'9'])then
begin Messagebox(handle,'You must use whole numbers and positive',gamename,
mb_iconinformation);entergamenumber1click(nil);exit;
end;
shellexecute(0,nil,pchar(paramstr(0)),pchar(gamenum),nil,sw_show);exitprocess(0);
end;

procedure TAcesUpTable.ChangeCardDeck1Click(Sender: TObject);
begin
changedeckwnd.Visible:=true;
end;

procedure TAcesUpTable.FormKeyPress(Sender: TObject; var Key: Char);
begin
case key of
'a':paintbox1mousedown(paintbox1,mbleft,[],0,0);
'A':paintbox1mousedown(paintbox1,mbright,[],0,0);
'b':paintbox1mousedown(paintbox2,mbleft,[],0,0);
'B':paintbox1mousedown(paintbox2,mbright,[],0,0);
'c':paintbox1mousedown(paintbox3,mbleft,[],0,0);
'C':paintbox1mousedown(paintbox3,mbright,[],0,0);
'd':paintbox1mousedown(paintbox4,mbleft,[],0,0);
'D':paintbox1mousedown(paintbox4,mbright,[],0,0);
#32:paintbox5click(nil);
end;
end;

procedure TAcesUpTable.Exit1Click(Sender: TObject);
begin
close;
end;

procedure TAcesUpTable.PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var hk:hkey;
b:boolean;
begin
regcreatekey(hkey_current_user,GAME_KEY_NAME,hk);
b:=(regqueryvalueex(hk,NoHints,nil,nil,nil,nil)=error_success);regclosekey(hk);
if b then exit;
if hasmoves(tpaintbox(sender).tag)then tpaintbox(sender).cursor :=crhandpoint
else tpaintbox(sender).cursor:=crdefault;
end;

procedure TAcesUpTable.NoHints1Click(Sender: TObject);
var hk:hkey;
begin
nohints1.checked:=not nohints1.Checked;
regcreatekey(hkey_current_user,game_key_name,hk);
if nohints1.Checked then regsetvalueex(hk,nohints,0,reg_sz,@nohintsdescription[1],
(1+length(nohintsdescription))*sizeof(char))else regdeletevalue(hk,nohints);
regclosekey(hk);
end;

procedure TAcesUpTable.HowToUseThisGame1Click(Sender: TObject);
begin
displayhelp;
end;

function divide(n,d:extended):extended;
begin
result:=0;
if d=0then exit;
result:=n/d;
end;

procedure TAcesUpTable.HighScores1Click(Sender: TObject);
var mbtext:array[0..1024]of char;
hk:hkey;
rs:dword;
stats:tscorestats;
begin
zeromemory(@stats,sizeof(Stats));
rs:=sizeof(stats);
regopenkey(hkey_current_user,game_key_name,hk);
regqueryvalueex(hk,gamestats,nil,nil,@stats,@rs);
regclosekey(hk);
messagebox(handle,strfmt(mbtext,pchar(
'Games Played: %u'#13#10+
'Games won: %u'#13#10+
'Games lost: %u'#13#10+
'Winning percentage: %f%%'#13#10+
'Losing percentage: %f%%'),
[trunc(stats.GamesPlayed),trunc(stats.gameswon),trunc(stats.gamesplayed-
stats.gameswon),divide(stats.gameswon,stats.gamesplayed)*100,100-(divide(
stats.gameswon,stats.gamesplayed)*100)]),
'Aces Up Statistics',0);
end;

end.
unit acesupUnit2;
//Change card deck unit
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,shellapi, ExtDlgs;

const card_width=71;
card_height=96;
CUSTOM_CARD_BACK='Settings\AcesUp.bac';
type
  TChangeDeckWND = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    ScrollBar1: TScrollBar;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button5Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ChangeDeckWND: TChangeDeckWND;

implementation
uses acesupunit1;
{$R *.DFM}

procedure TChangeDeckWND.Button1Click(Sender: TObject);
var hk:hkey;
ba:dword;
begin
regcreatekey(hkey_current_user,GAME_KEY_NAME,hk);
if checkbox1.checked then ba:=255 else ba:=scrollbar1.Position;
Regsetvalueex(hk,'CardBack',0,reg_dword,@ba,4);
regclosekey(hk);
if ba=255then back:=random(12)else back:=ba;
shellexecute(0,nil,pchar(paramstr(0)),'/',nil,sw_show);exitprocess(0);
end;

procedure TChangeDeckWND.Button2Click(Sender: TObject);
var hk:hkey;
begin
regcreatekey(hkey_current_user,GAME_KEY_NAME,hk);
regdeletevalue(hk,'DeckDLL');
Regdeletevalue(hk,'CardBack');
regclosekey(hk);
shellexecute(0,nil,pchar(paramstr(0)),'/',nil,sw_show);exitprocess(0);
end;

procedure TChangeDeckWND.Button3Click(Sender: TObject);
var hk:hkey;
hdec:hmodule;
buff:array[0..max_path]of char;
begin
if not opendialog1.Execute then exit;
hdec:=loadlibrary(pchar(opendialog1.filename));
if hdec=0 then begin messagebox(handle,pchar(syserrormessage(getlasterror)),
'delphijustin Card Deck',mb_iconerror);exit;end;
hdeck:=hdec;
regcreatekey(hkey_current_user,game_key_name,hk);
regsetvalueex(hk,'DeckDLL',0,reg_sz,strpcopy(buff,opendialog1.filename),length(
opendialog1.filename)+1);
Regclosekey(hk);
end;

procedure TChangeDeckWND.Button4Click(Sender: TObject);
begin
shellexecute(0,nil,'https://delphijustin.biz/bin/carddecks',nil,nil,sw_show);
end;

procedure TChangeDeckWND.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
acesuptable.FormPaint(nil);
end;

procedure TChangeDeckWND.Button5Click(Sender: TObject);
begin
close;
end;

procedure TChangeDeckWND.FormPaint(Sender: TObject);
var bmp:tbitmap;
backst:array[0..8]of char;
i:integer;
begin
bmp:=tbitmap.Create;
bmp.Handle:=loadbitmap(hdeck,strfmt(backst,'BACK%d',[scrollbar1.position]));
canvas.Draw(0,0,bmp);
bmp.FreeImage;
bmp.Free;
if fileexists(custom_card_back)then canvas.Draw(0,0,bback);
end;

procedure TChangeDeckWND.ScrollBar1Change(Sender: TObject);
begin
formpaint(nil);
end;

procedure TChangeDeckWND.Button6Click(Sender: TObject);
var uncropped,cropped:tbitmap;
begin
if not openpicturedialog1.Execute then exit;
uncropped:=tbitmap.Create;
uncropped.LoadFromFile(openpicturedialog1.FileName);
cropped:=tbitmap.Create;
cropped.Height:=card_height;
cropped.width:=card_width;
cropped.Canvas.StretchDraw(rect(0,0,card_width,card_height),uncropped);
cropped.SaveToFile(custom_card_back);
bback.Free;
bback:=cropped;
formpaint(nil);
end;

end.