Перенести содержимое компонента Memo в матрицу

Наработки есть? или всё печально?

procedure TForm1.Button1Click(Sender: TObject);
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
  S : String;
  Sl : TStringList;
  Sg : TStringGrid;
  i, j, Len, P1, Row, Col : Integer;
begin
  Sg := StringGrid1;
  //Очистка таблицы.
  for i := 0 to Sg.ColCount - 1 do Sg.Cols[i].Clear;
  S := Memo1.Text;
  //Создание списка.
  Sl := TStringList.Create;
 
  //Выделяем слова и помещаем их в список.
  Len := Length(S);
  P1 := 0;
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if S[i] in D then Continue;
    //Отслеживаем начало слова.
    if (i = 1) or (S[i - 1] in D) then P1 := i;
    //Отслеживаем конец слова и добавляем слово в список.
    if (i = Len) or (S[i + 1] in D) then
      Sl.Add( Copy(S, P1, i - P1 + 1) )
    ;
  end;
 
  //Формируем таблицу нужных размеров.
  j := Round( Sqrt(Sl.Count) );
  if j * j < Sl.Count then j := j + 1;
  if j > 0 then begin
    StringGrid1.RowCount := j;
    StringGrid1.ColCount := j;
  end else begin
    //Таблица не может иметь нулевое количество строк или столбцов.
    StringGrid1.RowCount := 1;
    StringGrid1.ColCount := 1;
  end;
 
  //Заполняем таблицу словами.
  Row := 0;
  Col := 0;
  for i := 0 to Sl.Count - 1 do begin
    StringGrid1.Cells[Col, Row] := Sl[i];
    Inc(Col);
    if Col mod j = 0 then begin
      Inc(Row);
      Col := 0;
    end;
  end;
 
  //Удаляем список из памяти.
  Sl.Free;
end;