const
SizeArray = 11;
type
MyArrayType = array [1..SizeArray, 1..SizeArray] of string[1];
DirectionType = (dRight, dDown, dLeft, dUp);
procedure Spiral(var M : MyArrayType; SpirWrite : boolean; var S : string);
var
CurStep, Step, PosX, PosY : integer;
Direction : DirectionType; {от 1 до 4 - 1 вправо, 2 вниз, 3 влево, 4 вверх}
i : integer; {банальный счётчик по строке}
begin
i := 1;
PosX := 6; {round(SizeArray/2)}
PosY := 6;
CurStep := 1;
Step := 1; {через сколько шагов повернуть}
Direction := dRight; {фактически - это куда крутить спираль на первом шаге}
if Not SpirWrite {значит чтение из массива} then S := '';
while (PosX>0) and (PosX<=SizeArray) and (PosY>0) and (PosY<=SizeArray) do
begin
if SpirWrite then M[PosX, PosY] := S[i]
else S := S + M[PosX, PosY];
{вот, собественно и движение по матрице по спирали!}
case Direction of
dRight: begin PosY := PosY + 1;
if CurStep = Step then
begin
CurStep :=1; Direction := dDown;
end
else
CurStep := CurStep + 1;
end;
dDown : begin PosX := PosX + 1;
if CurStep = Step then
begin
CurStep :=1; Direction := dLeft;
Step := Step + 1;
end
else
CurStep := CurStep + 1;
end;
dLeft : begin PosY := PosY - 1;
if CurStep = Step then
begin
CurStep :=1; Direction := dUp;
end
else
CurStep := CurStep + 1;
end;
dUp : begin PosX := PosX - 1;
if CurStep = Step then
begin
CurStep :=1; Direction := dRight;
Step := Step + 1;
end
else
CurStep := CurStep + 1;
end;
end;
inc(i);
end;
end;
procedure DoCheck_and_Fix_String( var S : string; NeedLength : integer);
begin
if (NeedLength<1) or (NeedLength>255) then Exit;
if Length(S) > NeedLength then
S := Copy(S,1, NeedLength)
else
while length(S)
end;
var
Matrix : MyArrayType;
i, j : integer;
myS : string;
f : text;
begin
myS := '1234567890 This is just my favorite tesing string - you need very long string!';
i:= length( myS );
WriteLn('len S =',i);
DoCheck_and_Fix_String( myS, 121);
i:= length( myS );
WriteLn('len (fixed)=',i);
Spiral(Matrix, true, myS );
{выведем матрицу с помещенным туда текстом в текстовый файл}
Assign(f, 'SpirOut.txt');
Rewrite(f);
for i:=1 to 11 do
begin
for j:=1 to 11 do
Write(f, Matrix[i,j]);
WriteLn(f);
end;
Close(f);
end.
Простой
Средний
