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.

 > Turbo Pascal Онлайн Получить справку

Различия между изменённой записью 64637 оставленной Startearningmone 18.02.2025 в 13:06 и
оригинальной записью 1 оставленной OCTAGRAM 12.02.2017 в 06:08
Показать старую версию | новую версию | обе версии

    
1-
Program MineSweeper;
1+
jh344
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);
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}

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


картинка


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