Если у тебя депрессия, поговори с бомжом и дай ему кусок хлеба. Твоя депрессия развеется, как утренний туман! © Александр Дьяков 1042 - | 936 - или читать все...
Обратная связь Пожаловаться на материал

Функциональная модель приложения Судоку


⇐ ПредыдущаяСтр 10 из 10

 


 

ПРИЛОЖЕНИЕ Б

Диаграмма потоков данных приложения

ПРИЛОЖЕНИЕ В

Полный листинг приложения Судоку

unitunMain;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, Menus, SudokuSolve, XPMan,uHowPlay;

type

TfrmMain = class(TForm)

TimeTimer: TTimer;

MainMenu: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

btnNewGame: TMenuItem;

btnSaveGame: TMenuItem;

btnLoadGame: TMenuItem;

N7: TMenuItem;

btnExit: TMenuItem;

btnHowPlay: TMenuItem;

btnAbout: TMenuItem;

btnSolve: TMenuItem;

btnYouSudoku: TMenuItem;

N13: TMenuItem;

btnPrompt: TMenuItem;

N15: TMenuItem;

N17: TMenuItem;

N18: TMenuItem;

btnDifEasy: TMenuItem;

btnDifMidle: TMenuItem;

btnDifHard: TMenuItem;

dlgOpenGame: TOpenDialog;

dlgSaveGame: TSaveDialog;

Label1: TLabel;

XPManifest1: TXPManifest;

Label2: TLabel;

Bevel1: TBevel;

Label3: TLabel;

Bevel2: TBevel;

Label4: TLabel;

procedureFormPaint(Sender: TObject);

procedureFormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedureFormKeyPress(Sender: TObject; var Key: Char);

procedureFormCreate(Sender: TObject);

procedureTimeTimerTimer(Sender: TObject);

procedurebtnExitClick(Sender: TObject);

procedurebtnDifEasyClick(Sender: TObject);

procedurebtnDifMidleClick(Sender: TObject);

procedurebtnDifHardClick(Sender: TObject);

procedurebtnSaveGameClick(Sender: TObject);

procedurebtnLoadGameClick(Sender: TObject);

procedurebtnHowPlayClick(Sender: TObject);

procedurebtnNewGameClick(Sender: TObject);

procedurebtnSolveClick(Sender: TObject);

procedurebtnYouSudokuClick(Sender: TObject);

procedurebtnPromptClick(Sender: TObject);

procedurebtnAboutClick(Sender: TObject);

procedure N15Click(Sender: TObject);

private

{ Private declarations }

public

 

end;

TTime=record

Sec,Min,Hour: byte;

end;

 

const

Size=26;

crPen=50;

 

const

VeryHard: array[0..8,0..8] of byte=((8,5,0,0,0,2,4,0,0),

                                  (7,2,0,0,0,0,0,0,9),

                                  (0,0,4,0,0,0,0,0,0),

                                  (0,0,0,1,0,7,0,0,2),

                                  (3,0,5,0,0,0,9,0,0),

(0,4,0,0,0,0,0,0,0),

                                  (0,0,0,0,8,0,0,7,0),

                                  (0,1,7,0,0,0,0,0,0),

                                  (0,0,0,0,3,6,0,4,0));

SolveHard: array[0..8,0..8] of byte=((8,5,9,6,1,2,4,3,7),

                                   (7,2,3,8,5,4,1,6,9),

                                   (1,6,4,3,7,9,5,2,8),

                                   (9,8,6,1,4,7,3,5,2),

                                   (3,7,5,2,6,8,9,1,4),

                                   (2,4,1,5,9,3,7,8,6),

                                   (4,3,2,9,8,1,6,7,5),

(6,1,7,4,2,5,8,9,3),

(5,9,8,7,3,6,2,4,1));

 

var

frmMain: TfrmMain;

Map,SolveMap,RealMap: TSudokuBoard;

Difficult: byte=1;

Podskazka: integer=0;

 

MyTime: TTime;

CurX,CurY,OldX,OldY: integer;

 

implementation

 

usesuAbout;

 

{$R *.dfm}

 

procedureNULLTime;

begin

MyTime.Sec:=0;

MyTime.Min:=0;

MyTime.Hour:=0;

end;

 

functionCheckForSolve: boolean;

var

i,j: byte;

begin

for i:=0 to 8 do

for j:=0 to 8 do

if Map[i,j]<>SolveMap[i,j] then

begin

Result:=False;

Exit;

end;

Result:=true;

end;

 

procedureGeneratePlayBoard;

label m;

var

i,j,RandI,RandJ,iRet: byte;

begin

//генерируем решенную матрицу

m:

for i:=0 to 8 do

for j:=0 to 8 do

begin

Map[i,j]:=0;

SolveMap[i,j]:=0;

RealMap[i,j]:=0;

end;

//ставим рандомно несколько чисел на поле

for i:=1 to 21 do

begin

RandI:=random(9);

RandJ:=random(9);

ifSolveMap[RandI,RandJ]=0 then

begin

SolveMap[RandI,RandJ]:=random(9)+1;

if not CheckSudoku(SolveMap) then

begin

SolveMap[RandI,RandJ]:=0;

  Continue;

end;

end else Continue;

end;

//решаемСудоку

iRet:=Solve(SolveMap);

ifiRet<>1 then goto m;

i:=1;

case Difficult of

1:

whilei<=42 do

begin

RandI:=random(9);

RandJ:=random(9);

ifRealMap[RandI,RandJ]<>0 then Continue else

RealMap[RandI,RandJ]:=SolveMap[RandI,RandJ];

inc(i);

end;

2:

whilei<=32 do

begin

RandI:=random(9);

RandJ:=random(9);

ifRealMap[RandI,RandJ]<>0 then Continue else

RealMap[RandI,RandJ]:=SolveMap[RandI,RandJ];

inc(i);

end;

3:

whilei<=25 do

begin

RandI:=random(9);

RandJ:=random(9);

ifRealMap[RandI,RandJ]<>0 then Continue else

RealMap[RandI,RandJ]:=SolveMap[RandI,RandJ];

inc(i);

end;

end;

for i:=0 to 8 do

for j:=0 to 8 do

Map[i,j]:=RealMap[i,j];

end;

 

procedureTfrmMain.FormPaint(Sender: TObject);

var

i,j: integer;

begin

Canvas.Pen.Color:=clBlack;

Canvas.Font.Style:=[fsBold];

Canvas.Font.Size:=10;

for i:=1 to 10 do

for j:=1 to 10 do

if ((i mod 3)=1) and ((j mod 3)=1) then

begin

Canvas.Pen.Width:=2;

Canvas.MoveTo(i*Size,j*Size);

Canvas.LineTo(Size,j*Size);

Canvas.MoveTo(j*Size,i*Size);

Canvas.LineTo(j*Size,Size);

end else

begin

Canvas.Pen.Width:=1;

Canvas.MoveTo(i*Size,j*Size);

Canvas.LineTo(Size,j*Size);

Canvas.MoveTo(j*Size,i*Size);

Canvas.LineTo(j*Size,Size);

end;

Canvas.Brush.Color:=Color;

Canvas.Font.Color:=clRed;

for i:=0 to 8 do

for j:=0 to 8 do

if Map[i,j]<>0 then

Canvas.TextOut(i*Size+(size div 3)+Size,j*Size+(Size div 3)-2+Size,inttostr(Map[i,j]));

 

Canvas.Font.Color:=clBlack;

for i:=0 to 8 do

for j:=0 to 8 do

ifRealMap[i,j]<>0 then

Canvas.TextOut(i*Size+(size div 3)+Size,j*Size+(Size div 3)-2+Size,inttostr(RealMap[i,j]));

end;

 

procedureTfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Key:Byte;

begin

if (CurX<>0) or (CurY<>0) then

begin

Canvas.Brush.Color:=Color;

Canvas.Pen.Color:=Color;

Canvas.Rectangle(OldX,OldY,OldX+Size-3,OldY+Size-3);

Key:=Map[CurX-1,CurY-1];

if Key<>0 then

Canvas.TextOut(CurX*Size+(size div 3),CurY*Size+(Size div 3)-2,inttostr(Key));

end;

CurX:=trunc(x/Size);

CurY:=trunc(y/Size);

if (CurX>9) or (CurY>9) or (CurX<1) or (CurY<1) then Exit;

ifRealMap[CurX-1,CurY-1]=0 then

begin

Canvas.Brush.Color:=RGB(227,231,232);

Canvas.Pen.Color:=RGB(227,231,255);

Canvas.Rectangle(CurX*Size+2,CurY*Size+2,CurX*Size+Size-1,CurY*Size+Size-1);

Key:=Map[CurX-1,CurY-1];

Canvas.Pen.Color:=clRed;

if Key<>0 then

Canvas.TextOut(CurX*Size+(size div 3),CurY*Size+(Size div 3)-2,inttostr(Key));

end;

OldX:=CurX*Size+2;

OldY:=CurY*Size+2;

end;

 

procedureTfrmMain.FormKeyPress(Sender: TObject; var Key: Char);

var

SPods,SDiff,STime,SSec,SMin: String;

begin           //принажатиинаклавишу

case key of

'1'..'9':begin

Canvas.Pen.Color:=clRed;

Map[CurX-1,CurY-1]:=StrToInt(Key);

Canvas.TextOut(CurX*Size+(size div 3),CurY*Size+(Size div 3)-2,Key);

end;

'0':begin

if (CurX>9) or (CurY>9) or (CurX<1) or (CurY<1) then Exit;

ifRealMap[CurX-1,CurY-1]=0 then

begin

Map[CurX-1,CurY-1]:=0;

Canvas.Brush.Color:=RGB(227,231,232);

Canvas.Pen.Color:=RGB(227,231,255);

Canvas.Rectangle(CurX*Size+2,CurY*Size+2,CurX*Size+Size-1,CurY*Size+Size-1);

end;

end;

else key:=#0;

end;

FormPaint(Self);

ifCheckForSolve then

begin

ifMyTime.Sec<=9 then SSec:='0'+IntToStr(MyTime.Sec) else SSec:=IntToStr(MyTime.Sec);

ifMyTime.Min<=9 then SMin:='0'+IntToStr(MyTime.Min) else SMin:=IntToStr(MyTime.Min);

STime :=inttostr(MyTime.Hour)+' ч '+SMin+' м'+SSec+' с';

if Difficult=1 then SDiff:=' легкомуровне';

if Difficult=2 then SDiff:=' среднемуровне';

if Difficult=3 then SDiff:=' тяжеломуровне';

casePodskazka of

0,5..19,25..30,35..39,45..49,55..59,65..69,75..79: SPods:='подсказок';

1,21,31,41,51,61,71,81: SPods:='подсказку';

2..4,22..24,32..34,42..44,52..54,62..64,72..74: SPods:='подсказки';

end;

if Difficult<>3 then

MessageDlg('Вывыиграли!!!'+#13+

#13+

'Использовавприэтом '+inttostr(Podskazka)+' '+SPods+#13+

'На '+SDiff+#13+

         'За '+STime,mtInformation,[mbOk],0)

else

MessageDlg('Вывыиграли!!!'+#13+

         #13+

         'На '+SDiff+#13+

         'За '+STime+#13+

         ':)',mtInformation,[mbOk],0);

end;

end;

 

procedureTfrmMain.FormCreate(Sender: TObject);

begin

Randomize;

MyTime.Sec:=0;

MyTime.Min:=0;

MyTime.Hour:=0;

btnNewGameClick(self);

Screen.Cursors[crPen]:=LoadCursor(hInstance,'CHECK');

Screen.Cursor:=crPen;

end;

 

procedureTfrmMain.TimeTimerTimer(Sender: TObject);

var

SSec,SMin: String;

begin                  //счетчикпрошедшеговремени

ifMyTime.Sec>59 then

begininc(MyTime.Min);

MyTime.Sec:=0;

end;

ifMyTime.Min>59 then

begin

inc(MyTime.Hour);

MyTime.Min:=0;

end;

inc(MyTime.Sec);

ifMyTime.Sec<=9 then SSec:='0'+IntToStr(MyTime.Sec) else SSec:=IntToStr(MyTime.Sec);

ifMyTime.Min<=9 then SMin:='0'+IntToStr(MyTime.Min) else SMin:=IntToStr(MyTime.Min);

Label1.Caption := inttostr(MyTime.Hour)+' ч '+SMin+' м '+SSec+' с';

end;

 

procedureTfrmMain.btnExitClick(Sender: TObject);

begin                  //выход

Application.Terminate;

end;

 

procedureTfrmMain.btnDifEasyClick(Sender: TObject);

begin

//устанавливаемсложностьиначинаемсначала

Difficult:=1;

btnNewGameClick(Self);

label2.Caption:='Сложность - Легко';

btnPrompt.Enabled:=true;

label3.Visible:=true;

end;

 

procedureTfrmMain.btnDifMidleClick(Sender: TObject);

begin

//устанавливаем сложность и начинаем сначала

Difficult:=2;

btnNewGameClick(Self);

label2.Caption:='Сложность - Средне';

btnPrompt.Enabled:=true;

label3.Visible:=true;

end;

 

procedureTfrmMain.btnDifHardClick(Sender: TObject);

begin

//устанавливаем сложность и начинаем сначала

Difficult:=3;

btnNewGameClick(Self);

label2.Caption:='Сложность - Тяжело';

btnPrompt.Enabled:=false;

label3.Visible:=false;

end;

 

procedureTfrmMain.btnSaveGameClick(Sender: TObject);

var

F: TextFile;

i,j: byte;

ID: String[5];

begin                     //сохраняемигру

ID:='ssf__';

ifdlgSaveGame.Executethen

begin

AssignFile(F,dlgSaveGame.FileName);

ReWrite(F);

WriteLn(F,ID);

WriteLn(F,Difficult);

WriteLn(F,MyTime.Sec);

WriteLn(F,MyTime.Min);

WriteLn(F,Podskazka);

Write(F,MyTime.Hour);

for i:=0 to 8 do

begin

WriteLn(F);

for j:=0 to 8 do

Write(F,Map[j,i],' ');

end;

for i:=0 to 8 do

begin

WriteLn(F);

for j:=0 to 8 do

Write(F,SolveMap[j,i],' ');

end;

for i:=0 to 8 do

begin

WriteLn(F);

for j:=0 to 8 do

Write(F,RealMap[j,i],' ');

end;

CloseFile(F);

end;

end;

 

procedureTfrmMain.btnLoadGameClick(Sender: TObject);

var

F: TextFile;

i,j: byte;

ID:String[5];

begin                      //загружаемигру

ifdlgOpenGame.Execute then

begin

AssignFile(F,dlgOpenGame.FileName);

Reset(F);

ReadLn(F,ID);

if ID<>'ssf__' then

begin

MessageDlg('Неправильныйформатфайла!',mtError,[mbOk],0);

Exit;

end;

ReadLn(F,Difficult);

ReadLn(F,MyTime.Sec);

ReadLn(F,MyTime.Min);

ReadLn(F,Podskazka);

Read(F,MyTime.Hour);

for i:=0 to 8 do

begin

ReadLn(F);

for j:=0 to 8 do

Read(F,Map[j,i]);

end;

for i:=0 to 8 do

begin

ReadLn(F);

for j:=0 to 8 do

Read(F,SolveMap[j,i]);

end;

for i:=0 to 8 do

begin

ReadLn(F);

for j:=0 to 8 do

Read(F,RealMap[j,i]);

end;

CloseFile(F);

ifbtnYouSudoku.Caption='РешитьсвоюСудоку' then

btnYouSudoku.Caption:='ВвестисвоюСудокудлярешения';

btnSolve.Enabled:=true;

btnPrompt.Enabled:=true;

N18.Enabled:=true;

N15.Enabled:=true;

btnSaveGame.Enabled:=true;

if Difficult=1 then

begin

label2.Caption:='Сложность - Легко';

btnDifEasy.Checked:=true;

btnPrompt.Enabled:=true;

end;

if Difficult=2 then

begin

label2.Caption:='Сложность - Средне';

btnDifMidle.Checked:=true;

btnPrompt.Enabled:=true;

end;

if Difficult=3 then

begin

label2.Caption:='Сложность - Тяжело';

btnDifHard.Checked:=true;

btnPrompt.Enabled:=false;

end;

end;

label3.Caption:='Использованоподсказок - '+inttostr(Podskazka);

end;

 

procedureTfrmMain.btnHowPlayClick(Sender: TObject);

begin                   //какиграть?

frmHowPlay.Show;

end;

 

procedureTfrmMain.btnNewGameClick(Sender: TObject);

begin              //новаяигра

GeneratePlayBoard;

NULLTime;

FormPaint(Self);

Refresh;

btnSolve.Enabled:=true;

btnPrompt.Enabled:=true;

N18.Enabled:=true;

N15.Enabled:=true;

btnSaveGame.Enabled:=true;

ifbtnYouSudoku.Caption='РешитьсвоюСудоку' then

btnYouSudoku.Caption:='Ввести своюСудоку для решения';

podskazka:=0;

label3.Caption:='Использовано подсказок - '+inttostr(Podskazka);

end;

 

procedureTfrmMain.btnSolveClick(Sender: TObject);

var

i,j: byte;

begin

for i:=0 to 8 do

for j:=0 to 8 do

begin

Canvas.TextOut(i*Size+(size div 3)+1+Size,j*Size+(Size div 3)-1+Size,inttostr(SolveMap[i,j]));

Map[i,j]:=SolveMap[i,j];

end;

FormPaint(Self);

ifCheckForSolve then

MessageDlg('Вывыиграли!!!'+#13+

         'Носподсказкой.',mtInformation,[mbOk],0);

end;

 

procedureTfrmMain.btnYouSudokuClick(Sender: TObject);

var

i,j: byte;

begin

podskazka:=0;

label3.Caption:='Использованоподсказок - '+inttostr(Podskazka);

ifbtnYouSudoku.Caption='Ввести своюСудоку для решения' then

for i:=0 to 8 do

for j:=0 to 8 do

begin

RealMap[i,j]:=0;

Map[i,j]:=0;

SolveMap[i,j]:=0;

btnYouSudoku.Caption:='РешитьсвоюСудоку';

btnSolve.Enabled:=false;

btnPrompt.Enabled:=false;

N18.Enabled:=false;

N15.Enabled:=false;

btnSaveGame.Enabled:=false;

end else

ifbtnYouSudoku.Caption='РешитьсвоюСудоку' then

begin

ifCheckSudoku(Map)=false then

begin

MessageDlg('Неправильноеусловие',mtError,[mbOk],0);

Exit;

end;

if Solve(Map)<>1 then

begin

Refresh;

MessageDlg('Немогурешитьэтозадание!',mtWarning,[mbOk],0);

btnYouSudoku.Caption:='Ввести своюСудоку для решения';

btnSolve.Enabled:=true;

btnPrompt.Enabled:=true;

N18.Enabled:=true;

N15.Enabled:=true;

btnSaveGame.Enabled:=true;

Exit;

end;

btnYouSudoku.Caption:='ВвестисвоюСудокудлярешения';

btnSolve.Enabled:=true;

btnPrompt.Enabled:=true;

N18.Enabled:=true;

N15.Enabled:=true;

btnSaveGame.Enabled:=true;

end;

Refresh;

end;

 

procedureTfrmMain.btnPromptClick(Sender: TObject);

begin

if (CurX<>0) or (CurY<>0) then

if (RealMap[CurX-1,CurY-1]=0) then

begin

Map[CurX-1,CurY-1]:=SolveMap[CurX-1,CurY-1];

FormPaint(Self);

inc(Podskazka);

end else MessageDlg('Выберитеклетку!',mtInformation,[mbOk],0);

label3.Caption:='Использованоподсказок - '+inttostr(Podskazka);

end;

 

procedureTfrmMain.btnAboutClick(Sender: TObject);

begin

frmAbout.ShowModal;

end;

 

procedure TfrmMain.N15Click(Sender: TObject);

var

i,j: byte;

begin

for i:=0 to 8 do

for j:=0 to 8 do

begin

Map[i,j]:=VeryHard[j,i];

RealMap[i,j]:=VeryHard[j,i];

SolveMap[i,j]:=SolveHard[j,i];

end;

Refresh;

end;

 

end.

Дата добавления: 2019-07-15; просмотров: 226; Мы поможем в написании вашей работы!

Поделиться с друзьями:


⇐ Предыдущая12345678910


Мы поможем в написании ваших работ!
.
.
© 2014-2024 — Студопедия.Нет — Информационный студенческий ресурс. Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав (0.158)