for i:=1 to k do
        for j:=1 to k do
          write(f2,a[i+(j-1)*k]);

Uses CRT;
Const FILE_IN = 'Z1.txt';
       FILE_OUT = 'R1.txt';
Var i,j: Byte;
     a: Array[1..15] of String[15];
     read_line: String;
     res_line: String;
     f1, f2: Text;
     SIZE: Byte;
Begin
ClrScr;
{READ MESSAGE}
Assign(f1, FILE_IN);
ReSet(f1);
While not (eof(f1)) do
       Begin
       Readln(f1, read_line);
       res_line := res_line + read_line;
       End;
Close(f1);
Writeln('Message: ',res_line);
{/READ MESSAGE}

{PARSE SPACE}
For i := 1 to length(res_line) do
     Begin
     If (res_line[i] = ' ') then res_line[i] := '*';
     End;
{/PARSE SPACE}

{ALIGN TO *SIZE*}
If (Frac(sqrt(length(res_line))) < 0.00001) then SIZE := Round(sqrt(length(res_line)))
                    else SIZE := Trunc(sqrt(length(res_line)))+1;
Writeln('SIZE: ',SIZE);
While not (length(res_line) div SIZE = SIZE
) do
       Begin
       res_line := res_line + '.';
       End;
{/ALIGN TO *SIZE*}

{CREATE MATRIX}
For i := 1 to SIZE do
     Begin
     a[i] := Copy(res_line, 1, SIZE);
     Delete(res_line,1,SIZE);
     End;
{/CREATE MATRIX}

{ENCODE MESSAGE}
read_line := '';
For i := 1 to SIZE do
     For j := 1 to SIZE do
         Begin
         read_line := read_line + a[j][i];
         End;
Writeln('Code: ',read_line);
{/ENCODE MESSAGE}
ReadKey;
End.