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]0) And (M[X+1,Y]0) And (M[X,Y-1]0) And (M[X,Y+1]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.