Sudoku For Windows

This game is the simple 9×9 sudoku game that I designed. It runs on all 32-bit Windows and Windows 10. It has sound effects for when you solve the puzzle. Each puzzle is numbered. It autosaves the game as you change each cell. It has a timer. You can print a puzzle for when your not around a computer. It even works on NT 3.x, and Linux via Wine.
Screenshot
unit sudokuUnit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus,printers, ExtCtrls,mmsystem,shellapi;
const
APPVERSION='1.0.0.1';
sudo_win_value=2*3*4*5*6*7*8*9;
savedgame_exists=1;
stats_exists=2;
level_exists=4;
type
  TSudokuGame = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Edit13: TEdit;
    Edit14: TEdit;
    Edit15: TEdit;
    Edit16: TEdit;
    Edit17: TEdit;
    Edit18: TEdit;
    Edit19: TEdit;
    Edit20: TEdit;
    Edit21: TEdit;
    Edit22: TEdit;
    Edit23: TEdit;
    Edit24: TEdit;
    Edit25: TEdit;
    Edit26: TEdit;
    Edit27: TEdit;
    Edit28: TEdit;
    Edit29: TEdit;
    Edit30: TEdit;
    Edit31: TEdit;
    Edit32: TEdit;
    Edit33: TEdit;
    Edit34: TEdit;
    Edit35: TEdit;
    Edit36: TEdit;
    Edit37: TEdit;
    Edit38: TEdit;
    Edit39: TEdit;
    Edit40: TEdit;
    Edit41: TEdit;
    Edit42: TEdit;
    Edit43: TEdit;
    Edit44: TEdit;
    Edit45: TEdit;
    Edit46: TEdit;
    Edit47: TEdit;
    Edit48: TEdit;
    Edit49: TEdit;
    Edit50: TEdit;
    Edit51: TEdit;
    Edit52: TEdit;
    Edit53: TEdit;
    Edit54: TEdit;
    Edit55: TEdit;
    Edit56: TEdit;
    Edit57: TEdit;
    Edit58: TEdit;
    Edit59: TEdit;
    Edit60: TEdit;
    Edit61: TEdit;
    Edit62: TEdit;
    Edit63: TEdit;
    Edit64: TEdit;
    Edit65: TEdit;
    Edit66: TEdit;
    Edit67: TEdit;
    Edit68: TEdit;
    Edit69: TEdit;
    Edit70: TEdit;
    Edit71: TEdit;
    Edit72: TEdit;
    Edit73: TEdit;
    Edit74: TEdit;
    Edit75: TEdit;
    Edit76: TEdit;
    Edit77: TEdit;
    Edit78: TEdit;
    Edit79: TEdit;
    Edit80: TEdit;
    Edit81: TEdit;
    MainMenu1: TMainMenu;
    Game1: TMenuItem;
    Newgame1: TMenuItem;
    ChoosePuzzle1: TMenuItem;
    Level1: TMenuItem;
    Easiest1: TMenuItem;
    Easy1: TMenuItem;
    Medium1: TMenuItem;
    Hard1: TMenuItem;
    VeryHard1: TMenuItem;
    Print1: TMenuItem;
    PrintDialog1: TPrintDialog;
    Label1: TLabel;
    Label2: TLabel;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    AboutSudoku1: TMenuItem;
    RandomLevel1: TMenuItem;
    Timer1: TTimer;
    PauseResume1: TMenuItem;
    HowToPlay1: TMenuItem;
    BlankPuzzle1: TMenuItem;
    ResetPuzzle1: TMenuItem;
    Stats1: TMenuItem;
    StartSavingToafileinsteadofregistry1: TMenuItem;
    SaveDialog1: TSaveDialog;
    ExportPuzzle1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Print1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Newgame1Click(Sender: TObject);
    procedure Easiest1Click(Sender: TObject);
    procedure ChoosePuzzle1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure AboutSudoku1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure PauseResume1Click(Sender: TObject);
    procedure HowToPlay1Click(Sender: TObject);
    procedure BlankPuzzle1Click(Sender: TObject);
    procedure ResetPuzzle1Click(Sender: TObject);
    procedure Stats1Click(Sender: TObject);
    procedure StartSavingToafileinsteadofregistry1Click(Sender: TObject);
    procedure ExportPuzzle1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TSudokuGameDat=record
  gamenum:word;
  Puzzle:array[1..81]of byte;
  Enabled:array[1..81]of boolean;
  Time:TDateTime;
  end;
  TSudokuStat=record
  TotalTime:TDateTime;
  TotalPlayed:dword;
  end;
  TSudokuStats=array[1..5]of tsudokustat;
  TSudokuSav=record
  ValuesExist1:dword;
  SavedGame:tsudokugamedat;
  stats:TSudokuStats;
  Level:dword;
  end;
var
  SudokuGame: TSudokuGame;
  puzzleDat:TSudokuGameDat;
  puzzles: tstringlist;
  edits:array[1..81]of tedit;
  clevel,fen:dword;
  username:array[0..255]of char;
  loading:boolean=false;
  levels:array[1..5]of string=('Easiest','Easy','Medium','Hard','Very Hard');
  hkusr:hkey;
implementation

{$R *.DFM}
{$RESOURCE sudoku32.res}

function ImportSavFile:boolean;
var hf:THandle;
data:tsudokusav;
savname:string;
dwBytes,rtSize:dword;
begin
savname:=changefileext(paramstr(0),'.sav');
zeromemory(@Data,sizeof(data));
hf:=createfile(pchar(savname),generic_read,0,nil,open_existing,
file_attribute_normal,0);result:=(hf<>INVALID_HANDLE_VALUE);
if not result then exit;
readfile(hf,rtsize,4,dwBytes,nil);
readfile(hf,data,sizeof(data),dwBytes,nil);closehandle(hf);
result:=(dwBytes+rtsize=sizeof(data)*2);if not result then exit;
if(data.valuesexist1 and level_EXISTS>0)then regsetvalueex(hkusr,'Level',0,
reg_dword,@data.level,4)else regdeletevalue(hkusr,'Level');
if(Savedgame_exists and data.ValuesExist1>0)then regsetvalueex(hkusr,'SavedGame',
0,reg_binary,@data.SavedGame,sizeof(data.savedgame))else regdeletevalue(hkusr,
'SavedGame');
if(stats_exists and data.ValuesExist1>0)then regsetvalueex(hkusr,'Stat',0,
reg_binary,@data.stats,sizeof(data.stats))else regdeletevalue(hkusr,'Stat');
end;

function ExportSavFile:boolean;
var hf:thandle;
uname,compuname:array[0..255]of char;
savname,Footer:string;
unsize,cnsize,rs,dwBytes:dword;
data:tsudokusav;
begin
savname:=changefileext(paramstr(0),'.sav');
zeromemory(@data,sizeof(data));
rs:=4;
data.ValuesExist1:=(LEVEL_EXISTS*Byte(Regqueryvalueex(hkusr,'Level',nil,nil,
@data.level,@rs)=error_success))or data.valuesexist1;
rs:=Sizeof(data.stats);
data.ValuesExist1:=(stats_EXISTS*Byte(Regqueryvalueex(hkusr,'Stat',nil,nil,
@data.stats,@rs)=error_success))or data.valuesexist1;
rs:=Sizeof(data.savedgame);
data.ValuesExist1:=(savedgame_EXISTS*Byte(Regqueryvalueex(hkusr,'SavedGame',nil,
nil,@data.SavedGame,@rs)=error_success))or data.valuesexist1;
hf:=CreateFile(pchar(savname),generic_write,0,nil,create_always,
file_attribute_normal,0);result:=(hf<>INVALID_HANDLE_VALUE);
if not result then exit;
rs:=sizeof(data);
writefile(hf,rs,4,dwbytes,nil);
Writefile(hf,data,sizeof(data),dwBytes,nil);
cnsize:=256;unsize:=256;
getusername(uname,unsize);
getcomputername(compuname,cnsize);
footer:=format(#13#10'Sudoku v%s'#13#10'Last Exported on %s@%s',[appversion,uname,
compuname]);
result:=(dwBytes=Sizeof(data));
writefile(hf,footer[1],length(footer),dwbytes,nil);
closehandle(hf);
end;
procedure LoadPuzzles(level:dword);
var rpuzzle:tresourcestream;
begin
randomize;
if level=0 then clevel:=random(5)+1;
if level>5then clevel:=1 else clevel:=level;
rpuzzle:=tresourcestream.CreateFromID(hinstance,clevel,'PUZZLES');
puzzles.LoadFromStream(rpuzzle);
rpuzzle.Free;
case clevel of
1:sudokugame.Easiest1.Checked:=true;
2:sudokugame.easy1.Checked:=true;
3:sudokugame.medium1.Checked:=true;
4:sudokugame.hard1.Checked:=true;
5:sudokugame.veryhard1.Checked:=true;
end;
end;

procedure opengame;
var i:integer;
begin
loading:=true;
sudokugame.Label1.Caption:='Puzzle: '+Inttostr(puzzledat.gamenum);
sudokugame.Label2.Caption:='Level: '+inttostr(clevel);
for i:=1to 81do
begin
edits[i].text:=inttostr(puzzledat.puzzle[i]);
edits[i].enabled:=puzzledat.enabled[i];
if edits[i].text='0'then edits[i].clear;
end;
loading:=false;
end;

procedure NewGame;
var i:integer;
begin
zeromemory(@puzzledat,sizeof(puzzledat));
puzzledat.gamenum:=Random(puzzles.count);
loading:=true;
for i:=1to 81 do begin
puzzledat.Puzzle[i]:=strtoint(puzzles[puzzledat.gamenum][i]);
edits[i].text:=inttostr(puzzledat.puzzle[i]);
edits[i].enabled:=(edits[i].text='0');
puzzledat.Enabled[i]:=edits[i].enabled;
if edits[i].enabled then edits[i].clear;
end;
sudokugame.Label1.Caption:='Puzzle: '+inttostr(puzzledat.gamenum);
Sudokugame.Label2.Caption:='Level: '+levels[clevel];
loading:=false;
end;

procedure TSudokuGame.FormCreate(Sender: TObject);
var I:integer;
rs:dword;
hkjustin:hkey;
unsize:dword;
bsaved:boolean;
begin
edits[1]:=edit1;
edits[2]:=edit2;
edits[3]:=edit3;
edits[4]:=edit4;
edits[5]:=edit5;
edits[6]:=edit6;
edits[7]:=edit7;
edits[8]:=edit8;
edits[9]:=edit9;
edits[10]:=edit10;
edits[11]:=edit11;
edits[12]:=edit12;
edits[13]:=edit13;
edits[14]:=edit14;
edits[15]:=edit15;
edits[16]:=edit16;
edits[17]:=edit17;
edits[18]:=edit18;
edits[19]:=edit19;
edits[20]:=edit20;
edits[21]:=edit21;
edits[22]:=edit22;
edits[23]:=edit23;
edits[24]:=edit24;
edits[25]:=edit25;
edits[26]:=edit26;
edits[27]:=edit27;
edits[28]:=edit28;
edits[29]:=edit29;
edits[30]:=edit30;
edits[31]:=edit31;
edits[32]:=edit32;
edits[33]:=edit33;
edits[34]:=edit34;
edits[35]:=edit35;
edits[36]:=edit36;
edits[37]:=edit37;
edits[38]:=edit38;
edits[39]:=edit39;
edits[40]:=edit40;
edits[41]:=edit41;
edits[42]:=edit42;
edits[43]:=edit43;
edits[44]:=edit44;
edits[45]:=edit45;
edits[46]:=edit46;
edits[47]:=edit47;
edits[48]:=edit48;
edits[49]:=edit49;
edits[50]:=edit50;
edits[51]:=edit51;
edits[52]:=edit52;
edits[53]:=edit53;
edits[54]:=edit54;
edits[55]:=edit55;
edits[56]:=edit56;
edits[57]:=edit57;
edits[58]:=edit58;
edits[59]:=edit59;
edits[60]:=edit60;
edits[61]:=edit61;
edits[62]:=edit62;
edits[63]:=edit63;
edits[64]:=edit64;
edits[65]:=edit65;
edits[66]:=edit66;
edits[67]:=edit67;
edits[68]:=edit68;
edits[69]:=edit69;
edits[70]:=edit70;
edits[71]:=edit71;
edits[72]:=edit72;
edits[73]:=edit73;
edits[74]:=edit74;
edits[75]:=edit75;
edits[76]:=edit76;
edits[77]:=edit77;
edits[78]:=edit78;
edits[79]:=edit79;
edits[80]:=edit80;
edits[81]:=edit81;
for i:=1to 81do edits[i].tag:=i;
puzzles:=tstringlist.Create;
clevel:=1;
bsaved:=false;
fen:=0;rs:=4;regcreatekey(hkey_current_user,'Software\Justin',hkjustin);
regqueryvalueex(hkjustin,'FileSavingEnabled',nil,nil,@fen,@rs);regclosekey(hkjustin);
startsavingtoafileinsteadofregistry1.Checked:=(fen=1)or fileexists(ChangeFileExt(
paramstr(0),'.sav'));
regcreatekey(hkey_current_user,'Software\Justin\Sudoku',hkusr);
if startsavingtoafileinsteadofregistry1.Checked then importsavfile;
clevel:=1;
rs:=4;
regqueryvalueex(hkusr,'Level',nil,nil,@clevel,@rs);
loadpuzzles(clevel);
rs:=Sizeof(puzzledat);
if(RegQueryValueex(hkusr,'SavedGame',nil,nil,@puzzledat,@rs)=error_success)or
bsaved then
begin
if messagebox(handle,'Do you want to resume last saved game?','Sudoku',mb_yesno or
mb_iconquestion)=idyes then opengame else newgame;
exit;
end;
newgame;
end;

function GetWinValue(row,typ:byte):integer;
var x:integer;
begin
result:=1;
case typ of
1:case row of
1:result:=puzzledat.puzzle[1]*puzzledat.puzzle[2]*puzzledat.puzzle[3]*
puzzledat.puzzle[4]*puzzledat.puzzle[5]*puzzledat.puzzle[6]*puzzledat.puzzle[7]*
puzzledat.puzzle[8]*puzzledat.puzzle[9];
2:result:=puzzledat.puzzle[10]*puzzledat.puzzle[11]*puzzledat.puzzle[12]*
puzzledat.puzzle[13]*puzzledat.puzzle[14]*puzzledat.puzzle[15]*
puzzledat.puzzle[16]*puzzledat.puzzle[17]*puzzledat.puzzle[18];
3:result:=puzzledat.puzzle[19]*puzzledat.puzzle[20]*puzzledat.puzzle[21]*
puzzledat.puzzle[22]*puzzledat.puzzle[23]*puzzledat.puzzle[24]*
puzzledat.puzzle[25]*puzzledat.puzzle[26]*puzzledat.puzzle[27];
4:result:=puzzledat.puzzle[28]*puzzledat.puzzle[29]*puzzledat.puzzle[30]*
puzzledat.puzzle[31]*puzzledat.puzzle[32]*puzzledat.puzzle[33]*
puzzledat.puzzle[34]*puzzledat.puzzle[35]*puzzledat.puzzle[36];
5:result:=puzzledat.puzzle[37]*puzzledat.puzzle[38]*puzzledat.puzzle[39]*
puzzledat.puzzle[40]*puzzledat.puzzle[41]*puzzledat.puzzle[42]*
puzzledat.puzzle[43]*puzzledat.puzzle[44]*puzzledat.puzzle[45];
6:result:=puzzledat.puzzle[46]*puzzledat.puzzle[47]*puzzledat.puzzle[48]*
puzzledat.puzzle[49]*puzzledat.puzzle[50]*puzzledat.puzzle[51]*
puzzledat.puzzle[52]*puzzledat.puzzle[53]*puzzledat.puzzle[54];
7:result:=puzzledat.puzzle[55]*puzzledat.puzzle[56]*puzzledat.puzzle[57]*
puzzledat.puzzle[58]*puzzledat.puzzle[59]*puzzledat.puzzle[60]*
puzzledat.puzzle[61]*puzzledat.puzzle[62]*puzzledat.puzzle[63];
8:result:=puzzledat.puzzle[64]*puzzledat.puzzle[65]*puzzledat.puzzle[66]*
puzzledat.puzzle[67]*puzzledat.puzzle[68]*puzzledat.puzzle[69]*
puzzledat.puzzle[70]*puzzledat.puzzle[71]*puzzledat.puzzle[72];
9:result:=puzzledat.puzzle[73]*puzzledat.puzzle[74]*puzzledat.puzzle[75]*
puzzledat.puzzle[76]*puzzledat.puzzle[77]*puzzledat.puzzle[78]*
puzzledat.puzzle[79]*puzzledat.puzzle[80]*puzzledat.puzzle[81];
end;
2:for x:=1to 9 do result:=result*puzzledat.puzzle[9*x-(row-1)];
3:case row of
1:begin for x:=1to 3do result:=result*puzzledat.puzzle[x];
for x:=10to 12do result:=result*puzzledat.puzzle[x];
for x:=19to 21do result:=result*puzzledat.puzzle[x];
 end;
2:begin for x:=4to 6do result:=result*puzzledat.puzzle[x];
for x:=13to 15do result:=result*puzzledat.puzzle[x];
for x:=22to 24do result:=result*puzzledat.puzzle[x];
 end;
 3:begin for x:=7to 9do result:=result*puzzledat.puzzle[x];
for x:=16to 18do result:=result*puzzledat.puzzle[x];
for x:=25to 27do result:=result*puzzledat.puzzle[x];
 end;
 4:begin for x:=28to 30do result:=result*puzzledat.puzzle[x];
for x:=37to 39do result:=result*puzzledat.puzzle[x];
for x:=46to 48do result:=result*puzzledat.puzzle[x];
 end;
 5:begin for x:=31to 33do result:=result*puzzledat.puzzle[x];
for x:=40to 42do result:=result*puzzledat.puzzle[x];
for x:=49to 51do result:=result*puzzledat.puzzle[x];
 end;
 6:begin for x:=34to 36do result:=result*puzzledat.puzzle[x];
for x:=43to 45do result:=result*puzzledat.puzzle[x];
for x:=52to 54do result:=result*puzzledat.puzzle[x];
 end;
 7:begin for x:=55to 57do result:=result*puzzledat.puzzle[x];
for x:=64to 66do result:=result*puzzledat.puzzle[x];
for x:=73to 75do result:=result*puzzledat.puzzle[x];
 end;
 8:begin for x:=58to 60do result:=result*puzzledat.puzzle[x];
for x:=67to 69do result:=result*puzzledat.puzzle[x];
for x:=76to 78do result:=result*puzzledat.puzzle[x];
 end;
 9:begin for x:=61to 63do result:=result*puzzledat.puzzle[x];
for x:=70to 72do result:=result*puzzledat.puzzle[x];
for x:=79to 81do result:=result*puzzledat.puzzle[x];
 end;
 end;
end;
end;

procedure HighlightCells(row,typ:byte; HasError:boolean);
var x:integer;
begin
case typ of
1:case row of
1:for x:=1to 9do if haserror then  edits[x].color:=clred else edits[x].color:=
clwindow;
2:for x:=10to 18do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
3:for x:=19to 27do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
4:for x:=28to 36do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
5:for x:=37to 45do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
6:for x:=46to 54do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
7:for x:=55to 63do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
8:for x:=64to 72do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
9:for x:=73to 81do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
end;
2:for x:=1to 9 do if haserror then edits[9*x-(row-1)].color:=clred else
edits[9*x-(row-1)].color:=clWindow;
3:case row of
1:begin for x:=1to 3do if haserror then edits[x].color:=clred else
edits[x].color:=clwindow;
for x:=10to 12do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
for x:=19to 21do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
 end;
2:begin for x:=4to 6do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=13to 15do if haserror then edits[x].color:=clred else
edits[x].color:=clwindow;for x:=22to 24do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;
 end;
 3:begin for x:=7to 9do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=16to 18do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=25to 27do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow; end;
 4:begin for x:=28to 30do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=37to 39do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=46to 48do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow; end;
 5:begin for x:=31to 33do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=40to 42do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=49to 51do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow; end;
 6:begin for x:=34to 36do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=43to 45do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=52to 54do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow; end;
 7:begin for x:=55to 57do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=64to 66do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow; end;
 8:begin for x:=58to 60do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=67to 69do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=76to 78do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow; end;
 9:begin for x:=61to 63do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=70to 72do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow;for x:=79to 81do if haserror then edits[x].color:=clred else edits[x].color:=
clwindow; end;
 end;
end;
end;

procedure TSudokuGame.Edit1Change(Sender: TObject);
var i,j:integer;
rs:dword;
bwon:boolean;
stat:tsudokustats;
wav:array[0..4]of char;
msg:array[0..255]of char;
begin
if loading then exit;
if not timer1.Enabled then timer1.Enabled:=true;
for i:=1to 81do puzzledat.Puzzle[i]:=strtointdef(edits[i].text,0);
bwon:=true;
for j:=1to 3do for i:=1to 9 do begin bwon:=bwon and(GetWinValue(i,j)=
sudo_win_value);if(GetWinValue(i,j)>0)and(getwinvalue(i,j)<>sudo_win_value)then
highlightcells(i,j,true)else highlightcells(i,j,false);
end;
regsetvalueex(hkusr,'SavedGame',0,reg_binary,@puzzledat,sizeof(puzzledat));
if bwon then begin
timer1.Enabled:=false;
zeromemory(@stat,sizeof(stat));
rs:=sizeof(stat);
regqueryvalueex(hkusr,'Stat',nil,nil,@stat,@rs);
stat[clevel].TotalTime:=stat[clevel].TotalTime+puzzledat.Time;
inc(stat[clevel].totalplayed);
regsetvalueex(hkusr,'Stat',0,reg_binary,@stat,sizeof(stat));
regdeletevalue(hkusr,'SavedGame');
PlaySound(strfmt(wav,'WIN%d',[random(2)]),hinstance,snd_resource or snd_sync);
messagebox(handle,strfmt(msg,'Congradulations! You Won!'#13#10+
'Games played: %d Average playing time: %d days %s',[stat[clevel].totalplayed,
trunc(stat[clevel].totaltime/stat[clevel].TotalPlayed),FormatDateTime('hh:nn:ss',
stat[clevel].totaltime/stat[clevel].totalplayed)]),'Sudoku',0);
for i:=1to 81 do edits[i].enabled:=false;

end;
end;

procedure printAnotherPuzzle;
var bmp:tbitmap;
begin
newgame;
printer.NewPage;
bmp:=sudokugame.GetFormImage;
printer.Canvas.StretchDraw(Rect(0,0,printer.PageWidth,printer.PageHeight),bmp);
end;

procedure TSudokuGame.Print1Click(Sender: TObject);
var bmp:tbitmap;
n,i:integer;
begin
n:=Strtointdef(inputbox('Number of puzzle','Number of puzzles to print','1'),1);
if not printdialog1.Execute then exit;
bmp:=GetFormImage;
printer.BeginDoc;
printer.Canvas.StretchDraw(rect(0,0,printer.PageWidth,printer.PageHeight),bmp);
for i:=2 to n do
printanotherpuzzle;
printer.EndDoc;
end;

procedure TSudokuGame.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if startsavingtoafileinsteadofregistry1.Checked then exportSavFile;
regclosekey(hkusr);
end;

procedure TSudokuGame.Newgame1Click(Sender: TObject);
begin
newgame;
end;

procedure TSudokuGame.Easiest1Click(Sender: TObject);
begin
clevel:=TMenuItem(Sender).tag;
regsetvalueex(hkusr,'Level',0,reg_dword,@clevel,4);
Easiest1.Checked:=false;
easy1.Checked:=false;
medium1.Checked:=false;
hard1.Checked:=false;
veryhard1.Checked:=false;
randomlevel1.Checked:=false;
loadpuzzles(clevel);
if messagebox(handle,'Do you want to start a new puzzle?','Sudoku',mb_yesno or
mb_iconquestion)=idyes then newgame;
end;

procedure TSudokuGame.ChoosePuzzle1Click(Sender: TObject);
var i:integer;
emsg:array[0..255]of char;
label tryagain;
begin
tryagain:
puzzledat.gamenum:=strtointdef(inputbox('Choose A Puzzle','Enter puzzle number',
inttostr(puzzledat.gamenum)),puzzledat.gamenum);
if(puzzledat.gamenum>=puzzles.Count) then begin
if Messagebox(handle,strfmt(emsg,'The puzzle number must be between 0 and %d.',[
puzzles.count-1]),'Sudoku',mb_iconexclamation or mb_okcancel)=id_cancel then exit;
goto tryagain;
end;
zeromemory(@puzzledat.puzzle,81);
puzzledat.Time:=0;
for i:=1to 81 do begin
puzzledat.Puzzle[i]:=strtoint(puzzles[puzzledat.gamenum][i]);
edits[i].text:=inttostr(puzzledat.puzzle[i]);
edits[i].enabled:=(edits[i].text='0');
puzzledat.Enabled[i]:=edits[i].enabled;
if edits[i].text='0' then edits[i].clear;
end;
sudokugame.Label1.Caption:='Puzzle: '+inttostr(puzzledat.gamenum);
Sudokugame.Label2.Caption:='Level: '+levels[clevel];
end;

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

procedure TSudokuGame.AboutSudoku1Click(Sender: TObject);
var msg:array[0..512]of char;
begin
Messagebox(handle,strfmt(msg,
'Sudoku v%s by Justin Roeder'#13#10'Puzzle database owned by printable-sudoku-puzzles.com',
[APPVERSION]),'About Sudoku',0);
end;

procedure TSudokuGame.Timer1Timer(Sender: TObject);
begin
puzzledat.Time:=puzzledat.Time+EncodeTime(0,0,1,0);
caption:=formatdatetime('"Sudoku ("hh:nn:ss")"',puzzledat.Time);
regsetvalueex(hkusr,'SavedGame',0,reg_binary,@puzzledat,sizeof(puzzledat));

end;

procedure TSudokuGame.PauseResume1Click(Sender: TObject);
var i:integer;
begin
timer1.Enabled:=not timer1.Enabled;
for i:=1to 81do edits[i].visible :=timer1.Enabled;
if not timer1.Enabled then caption:='Sudoku(paused)';

end;

procedure TSudokuGame.HowToPlay1Click(Sender: TObject);
var msg:array[0..1024]of char;
begin
messagebox(0,strpcopy(Msg,
'Objective of Sudoku is to fill every cell with digits 1 to 9'#13#10+
'But the rules are every row, column and 3x3 square must use the '#13#10+
'digits 1 to 9 once. Also when a full column,row or square is filled in wrong'#13#10+
'it is highlighted red.'),'Sudoku Rules',0);
end;

procedure TSudokuGame.BlankPuzzle1Click(Sender: TObject);
var i:integer;
begin
puzzledat.gamenum:=$ffff;
zeromemory(@puzzledat.puzzle,81);
fillmemory(@puzzledat.enabled,81,sizeof(puzzledat.enabled));
for i:=1to 81do begin edits[i].enabled:=true;edits[i].clear;end;

end;

procedure TSudokuGame.ResetPuzzle1Click(Sender: TObject);
var i:integer;
begin
if messagebox(handle,
'This will clear everything you entered.'#13#10'Do you wish to do that?',
'Sudoku',MB_YESNO or mb_iconquestion)<>idyes then exit;
for i:=1to 81do if edits[i].enabled then begin
puzzledat.Puzzle[i]:=0;
edits[i].clear;end;
end;

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

procedure TSudokuGame.Stats1Click(Sender: TObject);
var msg:array[0..255]of char;
stat:tsudokustats;
rs:dword;
begin
zeromemory(@stat,sizeof(stat));
rs:=sizeof(stat);
RegQueryValueex(hkusr,'Stat',nil,nil,@stat,@rs);
messagebox(handle,strfmt(msg,Pchar(
'Easiest Level:Games Played: %d Average Time: %d days %s'#13#10+
'Easy Level:Games Played: %d Average Time: %d days %s'#13#10+
'Medium Level:Games Played: %d Average Time: %d days %s'#13#10+
'Hard Level:Games Played: %d Average Time: %d days %s'#13#10+
'Very Hard Level:Games Played: %d Average Time: %d days %s'),[
stat[1].totalplayed,trunc(divide(stat[1].totaltime,stat[1].TotalPlayed)),
FormatDateTime('hh:nn:ss',divide(stat[1].totaltime,stat[1].TotalPlayed)),
stat[2].totalplayed,trunc(divide(stat[2].totaltime,stat[2].TotalPlayed)),
FormatDateTime('hh:nn:ss',divide(stat[2].totaltime,stat[2].TotalPlayed)),
stat[3].totalplayed,trunc(divide(stat[3].totaltime,stat[3].TotalPlayed)),
FormatDateTime('hh:nn:ss',divide(stat[3].totaltime,stat[3].TotalPlayed)),
stat[4].totalplayed,trunc(divide(stat[4].totaltime,stat[4].TotalPlayed)),
FormatDateTime('hh:nn:ss',divide(stat[4].totaltime,stat[1].TotalPlayed)),
stat[5].totalplayed,trunc(divide(stat[5].totaltime,stat[5].TotalPlayed)),
FormatDateTime('hh:nn:ss',divide(stat[5].totaltime,stat[5].TotalPlayed))]),
'Sudoku Stats',0);
end;

procedure TSudokuGame.StartSavingToafileinsteadofregistry1Click(
  Sender: TObject);
var hkjustin:HKey;
savname:string;
FileSavingEnabled:dword;
begin
startsavingtoafileinsteadofregistry1.Checked:=not startsavingtoafileinsteadofregistry1.Checked;
savname:=changefileext(paramstr(0),'.sav');
if startsavingtoafileinsteadofregistry1.Checked then exportsavfile else
deletefile(savname);
filesavingenabled:=byte(startsavingtoafileinsteadofregistry1.checked);
RegOpenKey(hkey_current_user,'Software\Justin',hkjustin);regsetvalueex(
hkjustin,'FileSavingEnabled',0,reg_dword,@filesavingenabled,4);regclosekey(hkjustin);
end;
function GetHTMLSudoku(edindex:byte):String;
begin
if edits[edindex].enabled then result:=format(
'<input type="text" maxlength="1" name="sudo%d" value="%s">',[edindex-1,
edits[edindex].text])else result:=format(
'%s<input type="hidden" name="sudo%d" value="%s">',[edits[edindex].text,edindex-1,
edits[edindex].text]);
end;
function SudokuSpace(edindex:byte):string;
begin
if edits[edindex].text=''then result:=#32#32else result:=#32+edits[edindex].text;
end;
function getfilecount:integer;
var i:integer;
begin
result:=1;
for i:=3to paramcount do
if paramstr(i)='/E'then result:=strtointdef(paramstr(i+1),1);
end;
procedure TSudokuGame.ExportPuzzle1Click(Sender: TObject);
var col,csv:tstringlist;
i,fn,c:integer;
forr:TResourceStream;
bm:tbitmap;
fns:String;
begin
if not savedialog1.Execute then exit;
fns:=extractfilepath(savedialog1.filename)+'\%d_'+
extractfilename(savedialog1.filename); 
c:=strtointdef(inputbox('Sudoku','Number of puzzles','1'),1);
for fn:=1to c do begin savedialog1.filename:=format(fns,[fn]);
if stricomp('.csv',pchar(extractfileext(savedialog1.filename)))=0then begin
col:=tstringlist.Create;
csv:=tstringlist.Create;
for i :=1to 9 do col.Add(edits[i].text);
csv.Add(col.commatext);col.Clear;
for i :=10to 18 do col.Add(edits[i].text);
csv.Add(col.commatext);col.Clear;
for i :=19to 27 do col.Add(edits[i].text);
csv.Add(col.commatext);col.Clear;
for i :=28to 36 do col.Add(edits[i].text);
csv.Add(col.commatext);col.Clear;
for i :=37to 45 do col.Add(edits[i].text);
csv.Add(col.commatext);col.Clear;
for i :=46to 54 do col.Add(edits[i].text);
csv.Add(col.commatext);col.Clear;
for i :=55to 63 do col.Add(edits[i].text);
csv.Add(col.commatext);col.Clear;
for i :=64to 72 do col.Add(edits[i].text);
csv.Add(col.commatext);col.Clear;
for i :=73to 81 do col.Add(edits[i].text);
csv.Add(col.commatext);col.Clear;
csv.SaveToFile(savedialog1.filename);
csv.Free;col.Free;
end else if stricomp('.txt',pchar(extractfileext(savedialog1.filename)))=0then
begin
forr:=tresourcestream.create(hinstance,'DOSTEXT','BIN');
csv:=tstringlist.create;
csv.loadfromstream(forr);
csv.text:=format(csv.text,[puzzledat.gamenum,
SudokuSpace(1),sudokuspace(2),sudokuspace(3),sudokuspace(4),sudokuspace(5),
sudokuspace(6),sudokuspace(7),sudokuspace(8),sudokuspace(9),
sudokuspace(10),sudokuspace(11),sudokuspace(12),sudokuspace(13),sudokuspace(14),
sudokuspace(15),sudokuspace(16),sudokuspace(17),sudokuspace(18),
sudokuspace(19),sudokuspace(20),sudokuspace(21),sudokuspace(22),sudokuspace(23),
sudokuspace(24),sudokuspace(25),sudokuspace(26),sudokuspace(27),
sudokuspace(28),sudokuspace(29),sudokuspace(30),sudokuspace(31),sudokuspace(32),
sudokuspace(33),sudokuspace(34),sudokuspace(35),sudokuspace(36),
sudokuspace(37),sudokuspace(38),sudokuspace(39),sudokuspace(40),sudokuspace(41),
sudokuspace(42),sudokuspace(43),sudokuspace(44),sudokuspace(45),
sudokuspace(46),sudokuspace(47),sudokuspace(48),sudokuspace(49),sudokuspace(50),
sudokuspace(51),sudokuspace(52),sudokuspace(53),sudokuspace(54),
sudokuspace(55),sudokuspace(56),sudokuspace(57),sudokuspace(58),sudokuspace(59),
sudokuspace(60),sudokuspace(61),sudokuspace(62),sudokuspace(63),
sudokuspace(64),sudokuspace(65),sudokuspace(66),sudokuspace(67),sudokuspace(68),
sudokuspace(69),sudokuspace(70),sudokuspace(71),sudokuspace(72),
sudokuspace(73),sudokuspace(74),sudokuspace(75),sudokuspace(76),sudokuspace(77),
sudokuspace(78),sudokuspace(79),sudokuspace(80),sudokuspace(81)]);
forr.Free;csv.SaveToFile(savedialog1.filename);csv.free;
end else if(stricomp('.htm',pchar(extractfileext(savedialog1.filename)))=0)or(
stricomp('.html',pchar(extractfileext(savedialog1.filename)))=0)then
begin
csv:=tstringlist.Create;
forr:=tresourcestream.Create(hinstance,'WEBPAGE1','BIN');
csv.LoadFromStream(forr);forr.Free;
csv.Text:=format(csv.Text,[puzzledat.gamenum,AppVersion,
GetHTMLSudoku(1),GetHTMLSudoku(2),GetHTMLSudoku(3),GetHTMLSudoku(4),GetHTMLSudoku(5),
GetHTMLSudoku(6),GetHTMLSudoku(7),GetHTMLSudoku(8),GetHTMLSudoku(9),
GetHTMLSudoku(10),GetHTMLSudoku(11),GetHTMLSudoku(12),GetHTMLSudoku(13),GetHTMLSudoku(14),
GetHTMLSudoku(15),GetHTMLSudoku(16),GetHTMLSudoku(17),GetHTMLSudoku(18),
GetHTMLSudoku(19),GetHTMLSudoku(20),GetHTMLSudoku(21),GetHTMLSudoku(22),GetHTMLSudoku(23),
GetHTMLSudoku(24),GetHTMLSudoku(25),GetHTMLSudoku(26),GetHTMLSudoku(27),
GetHTMLSudoku(28),GetHTMLSudoku(29),GetHTMLSudoku(30),GetHTMLSudoku(31),GetHTMLSudoku(32),
GetHTMLSudoku(33),GetHTMLSudoku(34),GetHTMLSudoku(35),GetHTMLSudoku(36),
GetHTMLSudoku(37),GetHTMLSudoku(38),GetHTMLSudoku(39),GetHTMLSudoku(40),GetHTMLSudoku(41),
GetHTMLSudoku(42),GetHTMLSudoku(43),GetHTMLSudoku(44),GetHTMLSudoku(45),
GetHTMLSudoku(46),GetHTMLSudoku(47),GetHTMLSudoku(48),GetHTMLSudoku(49),GetHTMLSudoku(50),
GetHTMLSudoku(51),GetHTMLSudoku(52),GetHTMLSudoku(53),GetHTMLSudoku(54),
GetHTMLSudoku(55),GetHTMLSudoku(56),GetHTMLSudoku(57),GetHTMLSudoku(58),GetHTMLSudoku(59),
GetHTMLSudoku(60),GetHTMLSudoku(61),GetHTMLSudoku(62),GetHTMLSudoku(63),
GetHTMLSudoku(64),GetHTMLSudoku(65),GetHTMLSudoku(66),GetHTMLSudoku(67),GetHTMLSudoku(68),
GetHTMLSudoku(69),GetHTMLSudoku(70),GetHTMLSudoku(71),GetHTMLSudoku(72),
GetHTMLSudoku(73),GetHTMLSudoku(74),GetHTMLSudoku(75),GetHTMLSudoku(76),GetHTMLSudoku(77),
GetHTMLSudoku(78),GetHTMLSudoku(79),GetHTMLSudoku(80),GetHTMLSudoku(81)]);
csv.savetofile(savedialog1.filename);csv.Free;
end else if stricomp('.bmp',pchar(extractfileext(savedialog1.filename)))=0then
begin
bm:=getformimage;
bm.SaveToFile(savedialog1.filename);
bm.Free;
end else begin
messagebox(handle,'Invalid file extension','Sudoku',mb_iconerror);
exit;
end;
if c>1then newgame;
end;
end;

end.

Published by Justin Roeder

I am an electronics engineer and computer programmer that has autism. I learned by myself

Leave a comment

Your email address will not be published. Required fields are marked *