Шифровальный квадрат, Шифровка и дешифровка текста Опции

[-Slavok-]

Помогите со след. задачей.
Дана след. матрица:
(0, 1, 0, 1, 0, 0, 1, 0)
(0, 0, 0, 0, 1, 0, 0, 0)
(1, 0, 1, 0, 0, 0, 1, 0)
(0, 0, 0, 1, 0, 0, 0, 0)
(0, 1, 0, 0, 0, 1, 0, 0)
(1, 0, 0, 0, 1, 0, 0, 0)
(0, 0, 1, 0, 0, 0, 1, 0)
(0, 0, 0, 1, 0, 0, 0, 1)
Вводится строка. Просматривается шифр. квадрат, если его элемент равен 1, то в новую символьную матрицу 8x8 на пересечении i-ого строки и j-ого столбца, т.е. там, где была 1 в шифр. квадрате, ставится текущий символ строки. Если шифр. кв. закончился, а строка нет, то шифр. кв. поворачивается вправо на 90 градусов и начинается просмотр нового шифр. кв. Процесс происходит пока не закончится строка. В рез-те мы получили симв. матрицу с зашифрованным текстом.
Стока длиной не более 64 символов.
Программу написал, но работет она неправильно, помогите найти ошибку или какой-нибудь др. метод решения. Заранее благодарю.
Вот код программы:

Код

uses
 Crt;
type
 Mass = array [1..8, 1..8] of 0..1;
var
 S, S1 : String;
 NewM : array [1..8, 1..8] of Char; {Матрица с зашифрованным текстом}
 P, I, J : Word;
 Bool : Boolean;
const
 Matr : Mass = ((0, 1, 0, 1, 0, 0, 1, 0),
                       (0, 0, 0, 0, 1, 0, 0, 0),
                       (1, 0, 1, 0, 0, 0, 1, 0),
                       (0, 0, 0, 1, 0, 0, 0, 0),
                       (0, 1, 0, 0, 0, 1, 0, 0),
                       (1, 0, 0, 0, 1, 0, 0, 0),
                       (0, 0, 1, 0, 0, 0, 1, 0),
                       (0, 0, 0, 1, 0, 0, 0, 1));

procedure ReadData;
var
 F : Text;
begin
 Assign(F, 'Text.txt');
 Reset(F);
 ReadLn(F, S);
 Close(F)
end;

procedure Povorot(var A : Mass);
var
 B : Mass;                          {Поворот матрицы A на 90 градусов}
 I, J : Word;
begin
 for I := 1 to 8 do
   for J := 1 to 8 do B[I, J] := 0;
 for I := 1 to 8 do
   for J := 1 to 8 do B[I, 9 - J] := A[J, I];
 for I := 1 to 8 do
   for J := 1 to 8 do A[I, J] := B[I, J];
end;

begin
 ClrScr;
 ReadData;
 for I := 1 to 8 do
   for J := 1 to 8 do NewM[I, J] := ' ';
 P := 1; Bool := True;
 while P <= Length(S) do
   begin
      I := 1; J := 1;
      while (I <= 8) and (Bool) do
         begin
            while J <= 8 do
               begin
                  if Matr[I, J] = 1
                  then
                     begin
                       NewM[I, J] := S[P];
                       Inc(P);
                       if P > Length(S)
                       then
                          begin
                            Break;
                            Bool := False
                          end;
                     end;
                  Inc(J)
               end;{Конец цикла с J}
            Inc(I);
            J := 1;
         end;{Конец цикла с I}
      if (P = 17) or (P = 33) or (P = 49)
      then Povorot(Matr)
   end;
 S1 := '';
 for I := 1 to 8 do
   for J := 1 to 8 do S1 := S1 + NewM[I, J];
 I := Length(S1);
 while S1[I] = ' ' do
   begin
     Delete(S1, I, 1);
     Dec(I)
   end;
 Write(S1);
end.