pastebin - collaborative debugging

pastebin is a collaborative debugging tool allowing you to share and modify code snippets while chatting on IRC, IM or a message board.

This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

 >  > Запись оставлена OCTAGRAM 12.02.2017 в 06:08 Получить справку

Запись оставлена OCTAGRAM 12.02.2017 в 06:08
Показать изменения, внесённые Larryasymn, DanielBync и Startearningmone | запустить | скачать | новая запись

  1. Program MineSweeper;
  2. {****************************************************************************}
  3. Uses    Crt,Graph,Dos;
  4. {****************************************************************************}
  5. Const   Board : FillPatternType=($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);
  6.         Xb=225;   Yb=150;   Rb=8;    Cb=8;    Mb=10;
  7.         Xi=158;   Yi=90;    Ri=16;   Ci=16;   Mi=40;
  8.         Xe=15;    Ye=90;    Re=16;   Ce=30;   Me=100;
  9.         Dim=20;
  10. {****************************************************************************}
  11. Type    Mine= record
  12.            Num:Integer;
  13.            Opened:Boolean;
  14.            Mistaken:Boolean;
  15.            Suspended1:Boolean;
  16.            Suspended2:Boolean;
  17.         end;
  18. {****************************************************************************}
  19. Var     InitialX,InitialY,FinalX,FinalY,FreeSpaces,TotalMines,FreeCounter,
  20.         Level,TotalRows,TotalColumns : Integer;
  21.         Over,Interupted:Boolean;
  22.         A:Array[1..Re,1..Ce] of Mine;
  23.         Ch:Char;
  24. {****************************************************************************}
  25.    Procedure OpenGraphics;
  26.    Var GraphDriver,GraphMode,ErrorCode:Integer;
  27.    begin
  28.       GraphDriver:=Detect;
  29.       InitGraph(GraphDriver,GraphMode,'X:\BP');
  30.       ErrorCode := GraphResult;
  31.       If (ErrorCode<>GrOk) then
  32.       begin
  33.          ClrScr;
  34.          Writeln('Graphics Error! ',GraphErrorMsg(ErrorCode));
  35.          Writeln('Please use School Pak to run this game...');
  36.          Writeln('Download it here: http://pascal.net.ru/SchoolPak ');
  37.          Write('Press any key...');
  38.          Ch:=Readkey;
  39.          Halt(1);
  40.       end;
  41.    end;
  42. {****************************************************************************}
  43.    Procedure Introduction;
  44.    Var i:Integer;
  45.    begin
  46.       ClearDevice;
  47.       SetColor(13);
  48.       Rectangle(40,120,600,310);
  49.       SetFillPattern(Board,1);
  50.       FloodFill(300,150,13);
  51.       SetTextStyle(DefaultFont,HorizDir,3);
  52.       OutTextXY(85,130,'Д');
  53.       SetTextStyle(DefaultFont,HorizDir,2);
  54.       OutTextXY(110,133,'обро пожаловать в игру Сапёр!');
  55.       SetColor(15);
  56.       For i:=0 to 24 do
  57.       begin
  58.          Line(325,154,325+10*i,154);
  59.          Line(325,155,325+10*i,155);
  60.          Line(325,154,325-10*i,154);
  61.          Line(325,155,325-10*i,155);
  62.          delay(50);
  63.       end;
  64.       SetTextStyle(DefaultFont,HorizDir,1);
  65.       OutTextXY(200,165,'*** Игра разработана ***');
  66.       OutTextXY(170,185,'- На языке программирования Pascal,');
  67.       OutTextXY(170,205,'- В университете Zimbabwe,');
  68.       OutTextXY(170,225,'- Yonas Tesfazghi weldeselassie,');
  69.       OutTextXY(170,245,'- В среду 23-го февраля 2000.');
  70.       SetColor(Yellow);
  71.       OutTextXY(200,280,'Нажмите любую клавишу для продолжения...');
  72.       Ch := ReadKey;
  73.    end;
  74. {****************************************************************************}
  75.    Procedure Timer(n:Integer);
  76.    Var h,m,s,hund:word;
  77.    begin
  78.       GetTime(h,m,s,hund);
  79.       If (n=1) then {The game is being started.}
  80.       begin
  81.          SetColor(2);
  82.          Rectangle(20,450,130,470);
  83.          Rectangle(510,450,610,470);
  84.          SetTextstyle(DefaultFont,HorizDir,1);
  85.          SetColor(12);
  86.          OutTextXY(25,440,'Время начала');
  87.          OutTextXY(517,440,'Время конца');
  88.          OutTextXY(35,457,Chr(h div 10+48));
  89.          OutTextXY(45,457,Chr(h mod 10+48));
  90.          OutTextXY(55,457,':');
  91.          OutTextXY(65,457,Chr(m div 10+48));
  92.          OutTextXY(75,457,Chr(m mod 10+48));
  93.          OutTextXY(85,457,':');
  94.          OutTextXY(95,457,Chr(s div 10+48));
  95.          OutTextXY(105,457,Chr(s mod 10+48));
  96.          SetTextstyle(DefaultFont,HorizDir,2);
  97.          OutTextXY(555,453,'?');
  98.       end
  99.       Else  {The player has won the game or the game is over.}
  100.       begin
  101.          SetFillPattern(Board,0);
  102.          FloodFill(550,460,2);
  103.          SetColor(12);
  104.          SetTextstyle(DefaultFont,HorizDir,1);
  105.          OutTextXY(522,457,Chr(h div 10+48));
  106.          OutTextXY(532,457,Chr(h mod 10+48));
  107.          OutTextXY(542,457,':');
  108.          OutTextXY(552,457,Chr(m div 10+48));
  109.          OutTextXY(562,457,Chr(m mod 10+48));
  110.          OutTextXY(572,457,':');
  111.          OutTextXY(582,457,Chr(s div 10+48));
  112.          OutTextXY(592,457,Chr(s mod 10+48));
  113.       end;
  114.    end;
  115. {*************************************************************** *************}
  116.    Procedure HelpMenu;
  117.    begin
  118.       ClearDevice;
  119.       SetTextStyle(DefaultFont,HorizDir,2);
  120.       SetColor(13);
  121.       Rectangle(259,0,379,20);
  122.       SetColor(2);
  123.       OutTextXY(280,3,'Сапёр');
  124.       SetColor(15);
  125.       SetTextStyle(DefaultFont,HorizDir,1);
  126.       Rectangle(10,20,630,479);
  127.       SetFillPattern(Board,1);
  128.       FloodFill(300,150,15);
  129.       SetColor(10);
  130.       OutTextXY(243,30,'Правила игры в Сапёр');
  131.       Line(237,40,408,40);
  132.       SetColor(7);
  133.       OutTextXY(25,50,'    Сапёр -- это игра с игровым полем и несколькими минами на этом поле.');
  134.       OutTextXY(25,65,'Поле поделено на мелкие квадраты, и количество этих квадратов и мин зависит');
  135.       OutTextXY(25,80,'от желаемого УРОВНЯ игры. Размер поля и количество мин на каждый уровнь');
  136.       OutTextXY(25,95,'следующие:');
  137.       OutTextXY(25,110,'');
  138.       SetColor(10);
  139.       OutTextXY(30,125,'   Уровень игры   #Строк    #Столбцов    #Квадратов   #Мин  ');
  140.       Line(53,135,150,135);   Line(173,135,223,135);   Line(255,135,325,135);
  141.       Line(360,135,437,135);  Line(462,135,495,135);
  142.       SetColor(15);
  143.       OutTextXY(55,140,'Новичок           8          8            8x8=64     10');
  144.       OutTextXY(55,155,'Любитель         16         16         16x16=256     40');
  145.       OutTextXY(55,170,'Эксперт          16         30         16x30=480    100');
  146.       SetColor(7);
  147.       OutTextXY(25,190,'  Мины ПРОИЗВОЛЬНО расставлены в квадратах, и ваша цель -- ТОЧНО определить');
  148.       OutTextXY(25,205,'месторасположение мин. Вы указываете их, нажимая клавишу       на квадрате');
  149.       OutTextXY(25,220,'с миной внутри.');
  150.       SetColor(14); OutTextXY(483,205,'<ESC>');
  151.       SetColor(7);  OutTextXY(170,220,'');
  152.       OutTextXY(25,235,'   Если в квадрате НЕТ мины, то на нём написано число, которое указывает');
  153.       OutTextXY(25,250,'количество соседних квадратов с минами. Чтобы узнать, ПУСТОЙ ли квадрат,');
  154.       OutTextXY(25,265,'нужно нажать клавишу         на нём. Однако, нажатие клавиши ENTER в');
  155.       SetColor(14); OutTextXY(194,265,'<ENTER>');
  156.       SetColor(7);  OutTextXY(485,265,'');
  157.       OutTextXY(25,280,'квадрате с миной приведёт к фатальному исходу. Поэтому нужно стараться');
  158.       OutTextXY(25,295,'не нажимать клавишу ENTER на квадрате с миной.');
  159.       OutTextXY(25,310,'   Когда вы начинаете игру, вы видите индикатор, квадрат, нарисованный');
  160.       OutTextXY(25,325,'особенным цветом. Вы можете передвигать индикатор в любую сторону клавишами');
  161.       SetColor(14); OutTextXY(25,340,'<СТРЕЛКИ>');   SetColor(7);
  162.       OutTextXY(87,340,' . В самом начале вы можете нажать клавишу ENTER где угодно, и');
  163.       OutTextXY(25,355,'этот квадрат будет обязательно пустым.');
  164.       OutTextXY(25,370,'   Если вы решили, что в квадрате есть мина, и поставили пометку, но');
  165.       OutTextXY(25,385,'передумали и хотите убрать пометку, нужно нажать клавишу ESC ещё раз на');
  166.       OutTextXY(25,400,'этои квадрате. На этот раз вы увидите знак вопроса, обозначающий, что вы');
  167.       OutTextXY(25,415,'отменяете пометку. Следующее нажатие ESC уберёт этот знак вопроса, и');
  168.       OutTextXY(25,430,'этот квадрат возвратится в изначальное нетронутое состояние.');
  169.       SetColor(13);   OutTextXY(150,450,'Нажмите    , чтобы остановить игру');
  170.       SetColor(14);   OutTextXY(64,470,'НАЖМИТЕ ЛЮБУЮ КЛАВИШУ ДЛЯ ПРОДОЛЖЕНИЯ...');
  171.       SetColor(15);   OutTextXY(390,470,'С наилучшими пожеланиями! Y.T.');
  172.       SetTextStyle(DefaultFont,HorizDir,2);
  173.       OutTextXY(215,447,'S');
  174.       Ch := Readkey;
  175.    end;
  176. {****************************************************************************}
  177.    Procedure WriteHeading(Y:Integer);
  178.    begin
  179.       SetColor(13);
  180.       Rectangle(136,Y,496,Y+40);
  181.       SetColor(Green);
  182.       SetTextStyle(DefaultFont,HorizDir,3);
  183.       OutTextXY(254, Y+10,'САПЁР');
  184.       SetColor(13);
  185.       If (Y=40) then
  186.       begin
  187.          Rectangle(235,Y+40,385,Y+60);
  188.          SetColor(yellow);
  189.          SetTextStyle(DefaultFont,HorizDir,2);
  190.          OutTextXY(257,Y+45,'Уровень');
  191.       end
  192.       Else
  193.       begin
  194.          Rectangle(220,Y+40,400,Y+60);
  195.          SetColor(Yellow);
  196.          SetTextStyle(DefaultFont,HorizDir,1);
  197.          If (Level=1) then
  198.                OutTextXY(255,Y+50,'Новичок')
  199.          Else if (Level=2) then
  200.                OutTextXY(240,Y+50,'Любитель')
  201.          Else  OutTextXY(265,Y+50,'Эксперт');
  202.       end;
  203.    end;
  204. {****************************************************************************}
  205.    Procedure SetData(GL:Integer);
  206.    begin
  207.       If (GL=1) then
  208.       begin
  209.          Level:=1;
  210.          TotalMines:=Mb;
  211.          TotalRows:=Rb;
  212.          TotalColumns:=Cb;
  213.          FreeSpaces:=Rb*Cb-Mb;
  214.          InitialX:=Xb;
  215.          InitialY:=Yb;
  216.       end
  217.       Else if (GL=2) then
  218.       begin
  219.          Level:=2;
  220.          TotalMines:=Mi;
  221.          TotalRows:=Ri;
  222.          TotalColumns:=Ci;
  223.          FreeSpaces:=Ri*Ci-Mi;
  224.          InitialX:=Xi;
  225.          InitialY:=Yi;
  226.       end
  227.       Else
  228.       begin
  229.          Level:=3;
  230.          TotalMines:=Me;
  231.          TotalRows:=Re;
  232.          TotalColumns:=Ce;
  233.          FreeSpaces:=Re*Ce-Me;
  234.          InitialX:=Xe;
  235.          InitialY:=Ye;
  236.       end;
  237.       FinalX:=InitialX+TotalColumns*Dim;
  238.       FinalY:=InitialY+TotalRows*Dim;
  239.    end;
  240. {****************************************************************************}
  241.    Procedure WelComing;
  242.    begin
  243.       Introduction;
  244.       HelpMenu;
  245.       ClearDevice;
  246.       WriteHeading(40);
  247.       SetColor(13);
  248.       Rectangle(40,120,600,270);
  249.       SetFillPattern(Board,1);
  250.       FloodFill(300,150,13);
  251.       SetColor(15);
  252.       SetTextStyle(DefaultFont,HorizDir,1);
  253.       OutTextXY(170,150,'Выберите уровень игры:');
  254.       OutTextXY(230,170,'1. Новичок,');
  255.       OutTextXY(230,190,'2. Любитель или');
  256.       OutTextXY(230,210,'3. Эксперт.');
  257.       SetColor(Yellow);
  258.       OutTextXY(220,245,'Нажмите 1, 2 или 3.');
  259.       Repeat
  260.          Ch:=Readkey;
  261.       Until (Ch in ['1','2','3']);
  262.       SetData(Ord(Ch)-48);
  263.    end;
  264. {****************************************************************************}
  265.    Procedure DrawNonOpened(X,Y:Integer);
  266.    begin
  267.       SetColor(DarkGray);
  268.       Rectangle(X,Y,X+Dim,Y+Dim);
  269.       SetFillPattern(Board,LightGray);
  270.       FloodFill(X+Dim div 2,Y+ Dim div 2,DarkGray);
  271.       Line(X+2,Y+Dim-2,X+Dim-2,Y+Dim-2);
  272.       Line(X+Dim-2,Y+2,X+Dim-2,Y+Dim-2);
  273.       SetColor(White);
  274.       Line(X+2,Y+2,X+Dim-2,Y+2);
  275.       Line(X+2,Y+2,X+2,Y+Dim-2);
  276.    end;
  277. {****************************************************************************}
  278.    Procedure DrawField;
  279.    Var i:Integer;
  280.    begin
  281.       ClearDevice;
  282.       WriteHeading(5);
  283.       SetColor(darkGray);
  284.       Rectangle(InitialX-10,InitialY-10,FinalX+10,FinalY+10);
  285.       SetFillPattern(Board,LightGray);
  286.       FloodFill(InitialX,InitialY,DarkGray);
  287.       For i:=1 to 11 do
  288.       begin
  289.          If (i in [1,2,3,4]) then
  290.          begin
  291.             SetColor(DarkGray);
  292.                Line(initialX-i,InitialY-i,InitialX-i,Finaly+i);
  293.                Line(InitialX-i,InitialY-i,FinalX+i,InitialY-i);
  294.             SetColor(White);
  295.                Line(InitialX-i,FinalY+i,FinalX+i,FinalY+i);
  296.                Line(FinalX+i,InitialY-i,FinalX+i,FinalY+i);
  297.          end
  298.          Else if (i in [9,10,11]) then
  299.          begin
  300.             SetColor(DarkGray);
  301.                Line(InitialX-i,FinalY+i,FinalX+i,FinalY+i);
  302.                Line(FinalX+i,InitialY-i,FinalX+i,FinalY+i);
  303.             SetColor(White);
  304.                Line(InitialX-i,InitialY-i,FinalX+i,InitialY-i);
  305.                Line(InitialX-i,InitialY-i,InitialX-i,FinalY+i);
  306.          end;
  307.       end;
  308.       SetColor(darkGray);
  309.          Rectangle(InitialX-1,InitialY-1,FinalX+1,FinalY+1);
  310.  
  311.    end;
  312. {****************************************************************************}
  313.    Procedure DrawBoard;
  314.    Var X,Y,i,j:Integer;
  315.    begin
  316.       DrawField;
  317.       For i:=0 to (TotalRows-1) do
  318.       begin
  319.          Y:=InitialY+Dim*i;
  320.          For j:=0 to (TotalColumns-1) do
  321.          begin
  322.             X:=InitialX+Dim*j;
  323.             DrawNonOpened(X,Y);
  324.          end;
  325.       end;
  326.    end;
  327. {****************************************************************************}
  328.    Procedure DrawNewIndicator(X,Y:Integer);
  329.    begin
  330.       SetColor(13);
  331.       Rectangle(X+3,Y+3,X+Dim-3,Y+Dim-3);
  332.       Rectangle(X+4,Y+4,X+Dim-4,Y+Dim-4);
  333.    end;
  334. {****************************************************************************}
  335.    Procedure RemoveOldIndicator(X,Y:Integer);
  336.    begin
  337.       SetColor(7);
  338.       Rectangle(X+3,Y+3,X+Dim-3,Y+Dim-3);
  339.       Rectangle(X+4,Y+4,X+Dim-4,Y+Dim-4);
  340.    end;
  341. {****************************************************************************}
  342.    Procedure MoveIndicator(Var X,Y,Row,Col:Integer; Ch:Char);
  343.    Var OldX,OldY:Integer;
  344.    begin
  345.       OldX:=X;
  346.       OldY:=Y;
  347.       Case Ch of
  348.          #72: If (Y>InitialY) then
  349.               begin
  350.                  Y:=Y-Dim;
  351.                  Dec(Row);
  352.               end;
  353.          #75: If (X>InitialX) then
  354.               begin
  355.                  X:=X-Dim;
  356.                  Dec(Col);
  357.               end;
  358.          #77: If ((X+Dim)<FinalX) then
  359.               begin
  360.                  X:=X+Dim;
  361.                  Inc(Col);
  362.               end;
  363.          #80: If ((Y+Dim)<FinalY) then
  364.               begin
  365.                  Y:=Y+Dim;
  366.                  Inc(Row);
  367.               end;
  368.       end;
  369.       If ((OldX<>X) or (OldY<>Y)) then
  370.       begin
  371.          RemoveOldIndicator(OldX,OldY);
  372.          DrawNewIndicator(X,Y);
  373.       end;
  374.    end;
  375. {****************************************************************************}
  376.    Procedure WriteNumber(X,Y,Row,Col:Integer);
  377.    Var Color:Integer;
  378.    begin
  379.       Case A[Row,Col].Num of
  380.          1: Color:=9;   4: Color:=1;    7: Color:=12;
  381.          2: Color:=2;   5: Color:=5;    8: Color:=13;
  382.          3: Color:=4;   6: Color:=3;    9: Color:=0;
  383.       end;
  384.       SetColor(Color);
  385.       SetTextStyle(DefaultFont,HorizDir,1);
  386.       If (A[Row,Col].Num=9) then
  387.             OutTextXY(X+7,Y+7,Chr(15))
  388.       Else  OutTextXY(X+7,Y+7,Chr(A[Row,Col].Num+48));
  389.    end;
  390. {****************************************************************************}
  391.    Procedure DrawOpened(X,Y,Row,Col:Integer);
  392.    var Color:Integer;
  393.    begin
  394.       If (A[Row,Col].Suspended2) then
  395.           DrawNonOpened(X,Y);
  396.       color:=1;
  397.       SetColor(Color);
  398.       Rectangle(X+1,Y+1,X+Dim-1,Y+Dim-1);
  399.       SetFillPattern(Board,LightGray);
  400.       FloodFill(X+Dim div 2,Y+Dim div 2,Color);
  401.       If (A[Row,Col].num<>0) then
  402.          WriteNumber(X,Y,Row,Col);
  403.    end;
  404. {****************************************************************************}
  405.    Procedure DrawSuspended1(X,Y:Integer);
  406.    Var Color:Integer;
  407.    begin
  408.       DrawNonOpened(X,Y);
  409.       Color:=Red;
  410.       SetColor(Color);
  411.       setTextStyle(defaultFont,HorizDir,1);
  412.       OutTextXY(X+7,Y+7,Chr(6));
  413.    end;
  414. {****************************************************************************}
  415.    Procedure DrawSuspended2(X,Y:Integer);
  416.    Var Color:Integer;
  417.    begin
  418.       DrawNonOpened(X,Y);
  419.       Color:=1;
  420.       SetColor(Color);
  421.       SetTextStyle(DefaultFont,HorizDir,1);
  422.       OutTextXY(X+7,Y+7,Chr(63));
  423.    end;
  424. {****************************************************************************}
  425.    Procedure OpenSurrounding(X,Y,Row,Col:Integer);
  426.    Var XX,YY,RR,CC,i,j:Integer;
  427.    begin
  428.       For i:=-1 to 1 do
  429.       begin
  430.          RR:=Row+i;
  431.          If (RR in [1..TotalRows]) then
  432.          begin
  433.             For j:=-1 to 1 do
  434.             begin
  435.                CC:=Col+j;
  436.                If (CC in [1..TotalColumns]) then
  437.                begin
  438.                   If (Not((A[RR,CC].Opened) or (A[RR,CC].Suspended1) or
  439.                           (A[RR,CC].Suspended2))) then
  440.                   begin
  441.                      A[RR,CC].Opened:=True;
  442.                      XX:=X+Dim*j;
  443.                      YY:=Y+Dim*i;
  444.                      DrawOpened(XX,YY,RR,CC);
  445.                      Inc(FreeCounter);
  446.                      If (A[RR,CC].Num=0) then
  447.                          OpenSurrounding(XX,YY,RR,CC);
  448.                   end;
  449.                end;
  450.             end;
  451.          end;
  452.       end;
  453.    end;
  454. {****************************************************************************}
  455.    Procedure Allocate(Row,Col:Integer);
  456.    Var R,C,RR,CC,Sum,i,j:Integer;
  457.    begin
  458.       For i:=1 to TotalMines do
  459.       begin
  460.          Randomize;
  461.          Repeat
  462.             R:=Random(TotalRows)+1;
  463.             C:=Random(TotalColumns)+1;
  464.          Until (((R<>Row) or (C<>Col)) and (A[R,C].Num<>9));
  465.          A[R,C].Num:=9;
  466.       end;
  467.       For R:=1 to TotalRows do
  468.       begin
  469.          For C:=1 to totalColumns do
  470.          begin
  471.             If (A[R,C].Num<>9) then
  472.             begin
  473.                Sum:=0;
  474.                For i:=-1 to 1 do
  475.                begin
  476.                   RR:=R+i;
  477.                   If (RR in [1..TotalRows]) then
  478.                   begin
  479.                      For j:=-1 to 1 do
  480.                      begin
  481.                         CC:=C+j;
  482.                         If (CC in [1..TotalColumns]) then
  483.                         begin
  484.                            If (A[RR,CC].Num=9) then
  485.                                Inc(Sum);
  486.                         end;
  487.                      end;
  488.                   end;
  489.                end;
  490.                A[R,C].Num:=Sum;
  491.             end;
  492.          end;
  493.       end;
  494.    end;
  495. {****************************************************************************}
  496.    Procedure DrawCross(X,Y,Row,Col:Integer);
  497.    Var Color:Integer;
  498.    begin
  499.       SetColor(Red);
  500.       Line(X+4,Y+4,X+Dim-4,Y+Dim-4);
  501.       Line(X+5,Y+4,X+Dim-3,Y+Dim-4);
  502.       Line(X+4,Y+Dim-4,X+Dim-4,Y+4);
  503.       Line(X+5,Y+Dim-4,X+Dim-3,Y+4);
  504.    end;
  505. {****************************************************************************}
  506.    Procedure Success;
  507.    begin
  508.       Timer(2);
  509.       SetColor(13);
  510.       SetTextStyle(DefaultFont,HorizDir,2);
  511.       OutTextXY(180,FinalY+25,'ПОЗДРАВЛЕНИЯ!');
  512.       SetTextStyle(DefaultFont,HorizDir,1);
  513.       OutTextXY(220,FinalY+45,'Вы выиграли игру.');
  514.    end;
  515. {****************************************************************************}
  516.    Procedure GameOver(X,Y:Integer);
  517.    Var XX,YY,Row,Col:Integer;
  518.    begin
  519.       Timer(2);
  520.       For Row:=1 to TotalRows do
  521.       begin
  522.          YY:=InitialY+(Row-1)*Dim;
  523.          For Col:=1 to TotalColumns do
  524.          begin
  525.             If (Not(A[Row,Col].Opened)) then
  526.             begin
  527.                XX:=InitialX+(Col-1)*Dim;
  528.                If (A[Row,Col].Mistaken) then
  529.                    DrawCross(XX,YY,Row,Col)
  530.                Else if ((A[Row,Col].Num=9) and
  531.                         (Not(A[Row,Col].Suspended1))) then
  532.                    DrawOpened(XX,YY,Row,Col);
  533.             end;
  534.          end;
  535.       end;
  536.       SetColor(1);{Now show where the MISTAKE occured.}
  537.       Rectangle(X+1,Y+1,X+Dim-1,Y+Dim-1);
  538.       SetFillPattern(Board,Red);
  539.       FloodFill(X+Dim div 2,Y+Dim div 2,1);
  540.       OutTextXY(X+7,Y+7,Chr(47));
  541.       OutTextXY(X+7,Y+7,Chr(92));
  542.       SetColor(13);
  543.       SetTextStyle(DefaultFont,HorizDir,2);
  544.       OutTextXY(130,FinalY+30,' Вы проиграли!');
  545.       SetTextStyle(DefaultFont,HorizDir,1);
  546.       OutTextXY(350,FinalY+35,' Игра окончена.');
  547.    end;
  548. {****************************************************************************}
  549.    Procedure Warning;
  550.    begin
  551.       SetColor(15);
  552.       SetTextStyle(DefaultFont,HorizDir,1);
  553.       OutTextXY(142,FinalY+25,'Вы действительно хотите прервать игру? (Y/N)');
  554.       Repeat
  555.          Ch:=Readkey;
  556.       Until (Ch in ['n','N','y','Y']);
  557.       If (Ch in ['y','Y']) then
  558.           Interupted:=True;
  559.       SetColor(0);
  560.       OutTextXY(142,FinalY+25,'Вы действительно хотите прервать игру? (Y/N)');
  561.    end;
  562. {****************************************************************************}
  563.    Procedure Play(Var X,Y,Row,Col:Integer);
  564.    begin
  565.       Repeat
  566.          Ch:=Readkey;
  567.       Until ((Ord(Ch) in [13,27,83,115]) or (Ch in [#72,#75,#77,#80]));
  568.       If (Ch in [#72,#75,#77,#80]) then
  569.            MoveIndicator(X,Y,Row,Col,Ch)
  570.       Else if (Ord(Ch)=13) then
  571.       begin
  572.          If (Not((A[Row,Col].Opened) or (A[Row,Col].Suspended1))) then
  573.          begin
  574.             A[Row,Col].Opened:=True;
  575.             DrawOpened(X,Y,Row,Col);
  576.             DrawNewIndicator(X,Y);
  577.             If (A[Row,Col].Num=9) then
  578.             begin
  579.                Over:=True;
  580.                GameOver(X,Y);
  581.             end
  582.             Else
  583.             begin
  584.                Inc(FreeCounter);
  585.                If (A[Row,Col].Num=0) then
  586.                    OpenSurrounding(X,Y,Row,Col);
  587.                If (FreeCounter=FreeSpaces) then
  588.                begin
  589.                   Over:=True;
  590.                   Success;
  591.                end;
  592.             end;
  593.          end;
  594.       end
  595.       Else if (Ord(Ch)=27) then
  596.       begin
  597.          If (Not(A[Row,Col].Opened)) then
  598.          begin
  599.             If (A[Row,Col].suspended1) then
  600.             begin
  601.                A[Row,Col].Suspended1:=False;
  602.                A[Row,Col].Suspended2:=True;
  603.                A[Row,Col].Mistaken:=False;
  604.                DrawSuspended2(X,Y);
  605.             end
  606.             Else if (A[Row,Col].Suspended2) then
  607.             begin
  608.                A[Row,Col].Suspended2:=False;
  609.                DrawNonOpened(X,Y);
  610.             end
  611.             Else
  612.             begin
  613.                A[Row,Col].Suspended1:=True;
  614.                DrawSuspended1(X,Y);
  615.                If (A[Row,Col].Num<>9) then
  616.                      A[Row,Col].Mistaken:=True
  617.             end;
  618.             DrawNewindicator(X,Y);
  619.          end;
  620.       end
  621.       Else Warning;
  622.    end;
  623. {****************************************************************************}
  624.    Procedure StartGame;
  625.    Var X,Y,Row,Col:Integer;
  626.    begin
  627.       Repeat
  628.          Over:=False;
  629.          Interupted:=False;
  630.          DrawBoard;
  631.          For Row:=1 to TotalRows do
  632.          begin
  633.             For Col:=1 to TotalColumns do
  634.             begin
  635.                A[Row,Col].Num:=0;
  636.                A[Row,Col].Opened:=False;
  637.                A[Row,Col].Mistaken:=False;
  638.                A[Row,Col].Suspended1:=False;
  639.                A[Row,Col].Suspended2:=False;
  640.             end;
  641.          end;
  642.          Randomize;
  643.          Row:=Random(TotalRows)+1;
  644.          Col:=Random(TotalColumns)+1;
  645.          X:=InitialX+(Col-1)*Dim;
  646.          Y:=InitialY+(Row-1)*Dim;
  647.          DrawNewIndicator(X,Y);
  648.          Repeat
  649.             Repeat
  650.                Ch:=Readkey;
  651.             Until ((Ch in [#72,#75,#77,#80]) or (Ord(Ch) in [13,83,115]));
  652.             If (Ch in [#72,#75,#77,#80]) then
  653.                MoveIndicator(X,Y,Row,Col,Ch)
  654.             Else if (Ord(Ch)=13) then
  655.             begin
  656.                Allocate(Row,Col);
  657.                A[Row,Col].Opened:=True;
  658.                DrawOpened(X,Y,Row,Col);
  659.                FreeCounter:=1;
  660.                DrawNewIndicator(X,Y);
  661.                If (A[Row,Col].Num=0) then
  662.                   OpenSurrounding(X,Y,Row,Col);
  663.                If (FreeCounter=FreeSpaces) then
  664.                begin
  665.                   Over:=True;
  666.                   Success;
  667.                end;
  668.             end
  669.             Else Warning;
  670.          Until ((Ord(Ch)=13) or (Interupted));
  671.          If (Ord(Ch)=13) then
  672.          begin
  673.             Timer(1);
  674.             Repeat
  675.                Play(X,Y,Row,Col);
  676.             Until ((Over) or (Interupted));
  677.          end;
  678.          SetColor(15);
  679.          SetTextStyle(DefaultFont,HorizDir,1);
  680.          If Interupted then
  681.          begin
  682.             OutTextXY(210,FinalY+25,'Вы покинули игру!');
  683.             OutTextXY(190,FinalY+45,'Хотите сыграть ещё раз? (Y/N)');
  684.          end
  685.          Else
  686.             OutTextXY(190,FinalY+60,'Хотите сыграть ещё раз? (Y/N)');
  687.          Repeat
  688.             Ch:=Readkey;
  689.          Until (Ord(Ch) in [78,89,110,121]);
  690.          If (Ord(Ch) in [89,121]) then
  691.          begin
  692.             If Interupted then OutTextXY(450,FinalY+45,'y');
  693.             SetColor(0);  OutTextXY(190,FinalY+60,'Хотите сыграть ещё раз? (Y/N)');
  694.             SetColor(15); OutTextXY(220,FinalY+60,'Какой уровень? (1,2 or 3)');
  695.             Repeat
  696.                Ch:=Readkey;
  697.             Until (Ord(Ch) in [49,50,51]);
  698.             SetData(Ord(Ch)-48);
  699.          end;
  700.       Until (Ord(Ch) in [78,110]);
  701.       ClearDevice;
  702.       CloseGraph;
  703.    end;
  704. {****************************************************************************}
  705. BEGIN{Main Program}
  706.    OpenGraphics;
  707.    WelComing;
  708.    StartGame;
  709. END.{Main Program}

Отправка исправлений и поправок. (cоздать новую запись)
После отправки поправок вы сможете посмотреть различия между старой и новой записью.

Использовать подсветку синтаксиса
В текущей реализации JS-DOS Read/ReadLn работают только при подключенном модуле Crt! Для подсветки отдельных строк используйте для них префикс @@


картинка


Запомнить мои настройки