Разработка приложения «Сапер» в интегрированной среде программирования Delphi/Lazarus

implementation

uses Sapper_About, Sapper_Option, Sapper_Spisok;

{$R *.dfm}

procedure TForm1.N7Click(Sender: TObject);

begin

   Form2.ShowModal;

   {вызов окна "О программе"}

end;

procedure TForm1.N9Click(Sender: TObject);

var

  path_itog,path_proga,path_: string;

  File_: file of option;

  T1: Option;

begin

path_itog:=path_ + 'option\option.dat'; {файл настоек}

AssignFile(File_,path_itog);

try {защита от сбоя. В случае ошибки программы произойдет оповещениен пользователя и завершение программы}

  Reset(File_);{открытие файла на ЧТЕНИЕ}

except

   on EInOutError do

    begin

    ShowMessage('Критическая ошибка доступа к файлу ' + path_Itog);

    exit;

end;

end;{конец оператора обработки ошибок}

Read(File_,T1);

{переприсвоение глобальным переменным}

Z_S:=T1.sound;

if Z_S=True then

begin

  path_proga:=ExtractFilePath(paramstr(0));{определяем путь программы}

  path_:=path_proga +  'sound\end.wav';

  PlaySound(PChar(path_), 0, SND_FILENAME); {завершение программы. Звук обеспечивается Uses MMsystem}

end;

Form1.Close;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

  path_proga,path_: string;

begin

  status:=3;

  path_proga:=ExtractFilePath(paramstr(0));{определяем путь программы}

  path_:=path_proga +  'sound\start.wav';

  PlaySound(PChar(path_), 0, SND_FILENAME); {старт программы. Звук обеспечивается Uses MMsystem}

  timer1.Enabled:=true;{вывод заставки}

end;

procedure TForm1.N2Click(Sender: TObject);

var

  T1:Option;

  File_: file of Option;{файл настроек}

  path_,path_itog:string;

  R,C:integer;

begin

Timer3.Enabled:=false;

Canvas.Brush.Color:=clBlack;

Canvas.Pen.Color:=clblack;

sec:=0;

min:=0;

timer2.Enabled:=false;

{вычисление папки-метоположения файла:)}

path_:=ExtractFilePath(paramstr(0));

path_itog:=path_ + 'option\option.dat'; {файл настоек}

AssignFile(File_,path_itog);

try {защита от сбоя. В случае ошибки программы произойдет оповещениен пользователя и завершение программы}

  Reset(File_);{открытие файла на ЧТЕНИЕ}

except

   on EInOutError do

    begin

    ShowMessage('Критическая ошибка доступа к файлу ' + path_Itog);

    exit;

    end;

end;{конец оператора обработки ошибок}

Read(File_,T1);

{переприсвоение глобальным переменным}

Z_X:=T1.kletka_x;

Z_Y:=T1.kletka_y;

Z_M:=T1.Mina;

Z_S:=T1.sound;

{ >> end << }

StaticText1.Visible:=False;

StaticText2.Visible:=False;

StatusBar1.Panels[0].text:='Осталось мин - ' + IntToStr(Z_M);

StatusBar1.Panels[2].text:='Найдено мин - 0';

form1.Clientwidth:=(40*Z_Y)+Z_Y-3;

form1.ClientHeight:=(40*Z_X)+Z_X+15;

statusBar1.panels[0].width:=round((form1.Width-80)/2);

statusBar1.panels[2].width:=round((form1.Width-80)/2);

statusBar1.panels[1].width:=58;

{В неотображаемые эл-ты массива, которые соответствуют

клеткам по границе игрового поля запишем число -3.

Это значение используется функцией Open для завершения

рекурсивного процесса открытия соседних пустых клеток}

for R:=0 to Z_X+1 do

for C:=0 to Z_Y+1 do

  Pole[R,C]:=-3;

NewGame();

ShowPole(Form1.Canvas, status);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if statictext1.Visible=true and statictext2.visible=false then

  begin

   statictext2.visible:=true;

   timer1.Enabled:=false;

   end;

  if statictext1.Visible=false then statictext1.visible:=true;

end;

procedure NewGame();

var

  n: integer; {количество оставшихся мин}

  k: integer; {количество мин в соседних клетках}

  R,C: integer; {координаты клетки}

begin

{очистка эл. массива}

for R:=1 to Z_X do

for C:=1 to Z_Y do

  Pole[R,C]:=0;

{расставляем мины}

Randomize();{инициализация генератора случайных вроде-бы-как чисел}

n:=0;

Repeat

R:=Random(Z_X)+1;

C:=Random(Z_Y)+1;

If Pole[R,C]<>9 Then

  begin

   Pole[R,C]:=9;

   n:=n+1;

  end;

Until (n=Z_M);

{вычислим количество мин в соседних клетках для каждой клеточки}

for R:=1 to Z_X do

for C:=1 to Z_Y do

if Pole[R,C]<>9 then

  begin

   k:=0;

   if Pole[R-1,C-1]=9 then k:=k+1;

   if Pole[R-1,C]=9 then k:=k+1;

   if Pole[R-1,C+1]=9 then k:=k+1;

   if Pole[R,C-1]=9 then k:=k+1;

   if Pole[R,C+1]=9 then k:=k+1;

   if Pole[R+1,C-1]=9 then k:=k+1;

   if Pole[R+1,C]=9 then k:=k+1;

   if Pole[R+1,C+1]=9 then k:=k+1;

   pole[R,C]:=k;

  end;

Flags:=0;  {не надено еще мин}

status:=0; {старт игры}

Z_M_Na:=0;{нет найденных мин}

end;{end NEWGAME}

{рисует поле}

Procedure ShowPole(Canvas: TCanvas; status: integer);

var

  R,C: integer;

Begin

for R:=1 to Z_X do

  for C:=1 to Z_Y do

  Kletka(Canvas,R,C,status);

end;{end SHOWPOLE}

procedure Kletka(Canvas: TCanvas; R,C,Status: integer);

var

  x,y: integer; {координаты вывода}

begin

x:=(C-1) * 40 +1 ;

y:=(R-1) * 40 +1;

if status=0 then

begin

  Canvas.Brush.Color:=clltGRAY;

  Canvas.Rectangle(x,y,x+40,y+40); {вычерчивает прямоугольник}

  exit;

end;

if Pole[R,C]<100 then

begin

  {закрашиваем неоткрытые клетки в серый цвет}

  Canvas.Brush.Color:=clltGRAY;

  Canvas.Rectangle(x,y,x+40,y+40);

  {если игра закончилась, то показываем мины}

  if (status=2) and (Pole[R,C]=9) then Mina(Canvas,x,y);

  exit;

end;

{открываем клетку}

Canvas.Brush.Color:=clWhite;

canvas.rectangle(x,y,x+40,y+40);

if Pole[R,C]=100 then exit; {клетку-то открыли, но она пустая, незадача...}

if (Pole[R,C] >= 101) and (Pole[R,C]<=108) then

begin

  Canvas.Font.Size:=14;

  Canvas.Font.Color:=clBLUE;

  Canvas.TextOut(x+4,Y+3,IntToStr(Pole[R,C]-100));

  exit;

end;

if ( Pole[R,C] >= 200 ) then Flag(Canvas, x, y);

if (Pole[R,C] = 109 ) then { на этой мине нам конец - подорвались мы :(( }

begin

  Canvas.Brush.Color := clRed;

  Canvas.Rectangle(x,y,x+40,y+40);

end;

if ( (Pole[R,C] mod 10) = 9)  and  (status = 2) then Mina(Canvas, x, y);

end;{end KLETKA}

{рисуем мину}

Procedure Mina(Canvas : TCanvas; x, y : integer);

begin

with Canvas do

  begin

  Brush.Color := clGreen;

  Pen.Color := clBlack;

  Rectangle(x+16,y+26,x+24,y+30);

  Rectangle(x+8,y+30,x+16,y+34);

  Rectangle(x+24,y+30,x+32,y+34);

  Pie(x+6,y+28,x+34,y+44,x+34,y+36,x+6,y+36);

  MoveTo(x+12,y+32); LineTo(x+26,y+32);

  MoveTo(x+8,y+36);  LineTo(x+32,y+36);

  MoveTo(x+20,y+22); LineTo(x+20,y+26);

  MoveTo(x+8, y+30); LineTo(x+6,y+28);

  MoveTo(x+32,y+30); LineTo(x+34,y+28);

end;

end;{end MINA}

{Рисуем флаг}

Procedure Flag( Canvas : TCanvas; x, y : integer);

var

  p : array [0..3] of TPoint;  { координаты флажка и нижней точки древка}

  m : array [0..4] of TPoint;  { буква М}

begin

{координаты точек флажка}

              p[0].x:=x+4;   p[0].y:=y+4;

              p[1].x:=x+30;  p[1].y:=y+12;

              p[2].x:=x+4;   p[2].y:=y+20;

              p[3].x:=x+4;   p[3].y:=y+36;  {нижняя точка древка}

  m[0].x:=x+8; m[0].y:=y+14;

              m[1].x:=x+8; m[1].y:=y+8;

              m[2].x:=x+10; m[2].y:=y+10;

              m[3].x:=x+12; m[3].y:=y+8;

              m[4].x:=x+12; m[4].y:=y+14;

with Canvas do

begin

{цвет кисти и карандаша}

Brush.Color := clRed;

Pen.Color := clRed;

Polygon(p);  {флажок}

Pen.Color := clBlack; {древко}

MoveTo(p[0].x, p[0].y);

LineTo(p[3].x, p[3].y);

{буква М}

Pen.Color := clWhite;

Polyline(m);

Pen.Color := clBlack;

end;

end;      {end FLAG}

{==================================================}

{==================================================}

{рекурсивная функция открывает текущую и все соседние клетки, в которых нет мин}

Procedure Open( R, C : integer);

begin

if Pole[R,C] = 0 then

  begin

  Pole[R,C] := 100;

  Kletka(Form1.Canvas, R,C, 1);

  Open(R,C-1);

  Open(R-1,C);

  Open(R,C+1);

  Open(r+1,c);

  Open(r-1,c-1); {обрабатываем примыкающие по диагоналям клетки}

  Open(R-1,C+1);

  Open(R+1,C-1);

  Open(R+1,C+1);

              end

else

  if (Pole[R,C] < 100) and ( Pole[R,C] <> -3 ) then

   begin

   Pole[R,C] := Pole[R,C] + 100;

   Kletka(Form1.Canvas, R, C, 1);

  end;

end;{end OPEN}

{обработка события OnPaint}

procedure TForm1.Form1Paint(Sender: TObject);

begin

  ShowPole(Form1.Canvas, status);

end; {end FORM1PAINT}

procedure TForm1.Timer2Timer(Sender: TObject);

begin

sec:=sec +1;

if sec<10 then h_time:= IntToStr(min) + ':' + '0' + IntToStr(sec);

if sec=60 then

   begin

    min:=min + 1;

    sec:=0;

    h_time:=IntToStr(min) + ':' + '0' + IntToStr(sec);

   end;

  if sec>=10 then h_time:= IntToStr(min) + ':' + IntToStr(sec);

StatusBar1.Panels[1].Text:=h_time;

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  R,C:integer;

  path_proga,path_:string;

begin

if status=2 then exit; {игра завершена}

if status=3 then exit; {игра завершена}

if status=0 then status:=1; {первый ход}

Timer2.Enabled:=True;

{преобразование координат мыши в индексы клетки поля}

R:=Trunc(y/40)+1;

C:=trunc(x/40)+1;

if button=mbLeft then

begin

   if Pole[R,C]=9 then

   begin

   {открыта клетка в которой мина!!!!! ВЗРЫВ!!!!!!!!!}

   Pole[R,C]:=Pole[R,C]+100;

   status:=2;{игра закончена вследствии гибели игрока}

   ShowPole(Form1.Canvas,status);

   timer2.Enabled:=false;{остановка таймера}

   if Z_S=True then

    begin

      path_proga:=ExtractFilePath(paramstr(0));{определяем путь программы}

      path_:=path_proga +  'sound\vzryv.wav';

      PlaySound(PChar(path_), 0, SND_FILENAME); {Взрыв!. Звук обеспечивается Uses MMsystem}

    end; {END взрыв}

   end;

  if Pole[R,C]<9 then Open(R,C);

end;

If button=mbRight then

    If Pole[R,C]>200 then

     Begin {если был установлен флаг, то повторное нажатие...}

     {...убираем флаг и закрываем клетку}

     Pole[R,C]:=Pole[R,C]-200;

     x:=(C-1)*40+1;

     y:=(R-1)*40+1;

     Canvas.Brush.Color := clLtGray;

     Canvas.Rectangle(x,y,x+40,y+40);

     Flags:=flags-1;

     StatusBar1.Panels[0].text:='Осталось мин - ' + IntToStr(Z_M - Flags);

     StatusBar1.Panels[2].text:='Найдено мин - ' + intToStr(Flags);

   end

else

   begin  {если клетку еще не обрабатывали...}

       {...поставить в клетку флаг}

       Flags := Flags + 1;

       StatusBar1.Panels[0].text:='Осталось мин - ' + IntToStr(Z_M - Flags);

       StatusBar1.Panels[2].text:='Найдено мин - ' + intToStr(flags);

        if  Pole[R,C] = 9 then Z_M_Na := Z_M_Na + 1;

        Pole[R,C] := Pole[R,C]+ 200;  {поставили флаг}