New console edition is available
unit sudokuUnit1;
interface
n
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.
The short URL of the present article is: https://delphijustin.biz/go/i1pe
Circuit Simulator