old/PAS/PATH.PAS

Program Voland8;
Uses Crt,Graph;
Const
  FirstX = 15;
  FirstY = 25;
Var
  Q:Byte;
  M:Array[0..9,0..9] Of Integer;
  KolFields:Byte;
  I,J:Byte;
  Min:Byte;
  GD,GM:Integer;
  Field:Byte;
  Change:Boolean;

Procedure RandomFill(PersentInp:Byte);
Var
  Persent:Byte;
  Color:Byte;
Begin
  Randomize;
  Persent:=0;
  While Persent < PersentInp Do
    Begin
      I:=Random(8)+1;
      J:=Random(8)+1;
      If M[I,J] = 0 Then
        Begin
          M[I,J]:=-1;
          Persent:=Persent+1;
        End;
    End;
  SetColor(15);
  For I:=0 To 8 Do
    Begin
      Line(FirstX+21*I,FirstY,FirstX+21*I,FirstY+8*21);
      Line(FirstX,FirstY+21*I,FirstX+8*21,FirstY+21*I);
    End;
  SetFillStyle(1,12);
  For I:=1 To 8 Do
    For J:=1 To 8 Do
      If M[I,J]<>0 Then
        Bar(FirstX+21*(I-1)+1,FirstY+21*(J-1)+1,FirstX+21*(I-1)+20-1,FirstY+21*
(J-1)+20-1);
End;
Procedure Ok;
Begin
  OutTextXY(450,400,'Пройти можно.');
End;
Procedure NotOk;
Begin
  OutTextXY(450,400,'Пройти нельзя.');
  ReadKey;
  CloseGraph;
  Halt;
End;
Procedure Check(X,Y:Byte);
Var
  Min:Byte;
Begin
  If M[X,Y] = -1 Then
    Begin
      Min:=255;
      If (M[X-1,Y]>0) And (M[X-1,Y]<Min) Then
        Min:=M[X-1,Y];
      If (M[X+1,Y]>0) And (M[X+1,Y]<Min) Then
        Min:=M[X+1,Y];
      If (M[X,Y-1]>0) And (M[X,Y-1]<Min) Then
        Min:=M[X,Y-1];
      If (M[X,Y+1]>0) And (M[X,Y+1]<Min) Then
        Min:=M[X,Y+1];
      If Min<255 Then
        Begin
          M[X,Y]:=Min+1;
          Change:=True;
        End;
    End;
End;
Procedure Find(X,Y:Byte);
Begin
  Delay(200);
  Bar(FirstX+21*(X-1)+1,FirstY+21*(Y-1)+1,FirstX+21*(X-1)+20-1,FirstY+21*(Y-1)+
20-1);

  If X>1 Then

    If M[X-1,Y]=M[X,Y]-1 Then
      Find(X-1,Y)
    Else
      If M[X,Y-1]=M[X,Y]-1 Then
        Find(X,Y-1)
      Else
        If M[X+1,Y]=M[X,Y]-1 Then
          Find(X+1,Y)
        Else
          If M[X,Y+1]=M[X,Y]-1 Then
            Find(X,Y+1);
End;
Begin
  ClrScr;
  Write('Введите процент заполнения<<<---');
  ReadLn(KolFields);
  KolFields:=Round((KolFields/100)*64);
  GD:=Detect;
  InitGraph(GD,GM,'c:\bp\bgi');
  SetFillStyle(1,5);
  Bar(1,1,GetMaxX,GetMaxY);
  SetFillStyle(1,0);
  Bar(FirstX,FirstY,FirstX+8*21,FirstY+8*21);
  For I:=1 To 8 Do
    For J:=1 to 8 Do
      M[I,J]:=0;
  RandomFill(KolFields);
  For I:=1 To 8 Do
    If M[1,I]=-1 Then M[1,I]:=1;
  Repeat
    Change:=False;
    For I:=2 to 8 Do
      For J:=1 To 8 Do
        Check(I,J);
  Until Not Change;
  Field:=0;
  Min:=255;
  For I:=8 DownTo 1 Do
    If (M[8,I]<=Min) And (M[8,I]>0) Then
      Begin
        Field:=I;
        Min:=M[8,I];
      End;
  If Field = 0 Then
    NotOk
  Else
     Ok;
  Delay(400);
  SetFillStyle(1,14);
  Find(8,Field);
  ReadKey;
End.