Выравнивание текста по ширине, не могу разобраться что делаю не так, прошу помощи Опции

[Feagor]

задача такова дана символьная матрица матрица n*m, вводятся строки длиной m<=255
затем текст выравнивается по ширине, т.е. добавить пробелы в местах где они есть, но так чтобы их разница между их количеством различалась не больше чем на 1.
Собственно листинг:

uses crt;
var a:array[1..255,1..255] of char;
    b,probeli:array[1..255] of integer;
    s:string;
    i,n,m,j,k:integer;
begin
  clrscr;
  writeln('Vvedite chisla n,m(kolichestvo strok,dlina stroki)');
  readln(n,m);
  for i:=1 to n do
        begin
          writeln('Vvedite ',i,' stroku');
          readln(s);
          b[i]:=length(s);
          for j:=1 to m do a[i,j]:=s[j];
        end;
 { for i:=1 to n do writeln(b[i]);}
  for i:=1 to n do
        begin
          for j:=1 to b[i] do if a[i,j]=' ' then probeli[i]:=probeli[i]+1;
          {writeln(probeli[i]);}
          if b[i]<m then
                begin
                 for j:=1 to b[i] do s[j]:=a[i,j];
                 j:=1;
                 while j<=b[i] do
                   begin
                     if s[j]=' ' then
                        begin
                          for k:=1 to ((m-b[i]) div probeli[i]) do insert(' ',s,j);
                        end;
                     j:=j+((m-b[i]) div probeli[i])+1;
                   end;
                 for j:=1 to m do a[i,j]:=s[j];
                end;
        end;
  for i:=1 to n do begin
  writeln;
  for j:=1 to m do write(a[i,j]);
  end;
  readkey;
end.

работает правда не правильно=(

Сообщение отредактировано: Feagor - 18.12.2007 9:31

[andriano]

1. Предполагаю, что в условии ошибка: матрица не n*m, а m*n.
2. Не понял, что делает фрагмент:

                 j:=1;
                 while j<=b[i] do
                   begin
                     if s[j]=' ' then
                        begin
                          for k:=1 to ((m-b[i]) div probeli[i]) do insert(' ',s,j);
                        end;
                     j:=j+((m-b[i]) div probeli[i])+1;
                   end;

Скорее всего, именно он и должен вставлять пробелы внутрь строки. Но почему-то делается это с фиксированным шагом.
Ведь, насколько я понял из условия, количество вставляемых пробелов должно быть неодинаковым в разных местах - чтобы обеспечить на выходе фиксированную длину строки.
Это разумно делать с помощью двух вложенных циклов:
- во врутреннем вставляется по одному пробелу в каждую последовательность пробелов,
- во внешнем эта операция повторяется до тех ор, пока строка не примет нужную длину.

k := 1; // счетчик внешнего цикла, а заодно - длина последовательности пробелов (сколько пропускать)
repeat
  j := 1;
  while (j < length(s)) and (length(s) < m) do begin
    if s[j] = ' ' then begin  // найдя пробел, вставляем еще один и "перепрыгиваем" через всю последовательность пробелов
      insert(' ',s,j);
      inc(j,k);
    end;
    inc(j);
  end;
  inc(k); 
until length(s)=m;

Еще пара замечаний:
- искать длину строки можно и сразу во втором цикле,
- целесообразно перед началом обработки строки исключить из нее все двойные пробелы, а также пробелы в начале и конце.

Сообщение отредактировано: andriano - 18.12.2007 21:58

[Feagor]

1. Предполагаю, что в условии ошибка: матрица не n*m, а m*n.

Нет в условии все верно n строк и m столбцов
За поправку спасибо, щас проверю...

[andriano]

Размер принято указывать в виде (размер по X)[*|x](размер по Y). Мы же не говоим 480x640 или 1024x1280.

[Feagor]

Размер принято указывать в виде (размер по X)[*|x](размер по Y). Мы же не говоим 480x640 или 1024x1280.

размер матрицы указывается не как x*y а как количество строк на количество столбцов...не веришь можешь почитать началы мат.анализа...хотя не советую - гадкая вещь

[Feagor]

че-то все перепроверил все равно не работает, почему то тупо в конец дорисовывает пробелы=(

[Client]

работает правда не правильно=(

А у меня она даже не компилируется

[andriano]

че-то все перепроверил все равно не работает, почему то тупо в конец дорисовывает пробелы=(

Ты свой прежний вариант, или тот, что предложил я?
Если последний, притом, с учетом предложенных остальных исправлений, должно работать (за одним исключением - если в строке изначально нет ни одного пробела).
Посмотри законченый вариант:

uses crt;
const
   m = 20;
   n = 10;
var
  a:array[1..n,1..m] of char;

procedure FillArray; // заполнение массива
var
  i,j,k : integer;
  ch : char;
begin
  for i := 1 to n do
    for j := 1 to m do
      a[i,j] := ' ';
  for i := 1 to n do begin
    k := m div 2 + random(m div 2);
    for j := 1 to k do
      if random(6) > 0 then
        a[i,j] := 'O';
  end;
end;

procedure WriteArray; // вывод массива на печать
var
  i,j,k : integer;
  ch : char;
begin
  for j := 1 to n do begin
    write('    [');
    for i := 1 to m do
      write(a[j,i]);
    writeln(']');
  end;
  writeln('==============================');
end;

var
  s:string;
  i,j,k,b:integer;
begin
  FillArray;
  WriteArray;
  for i:=1 to n do begin // перебор по строкам массива
    s := '';
    for j := 1 to m do
      s := s + a[i,j];           // переносим из строки массива в переменную типа строки
    while s[length(s)] = ' ' do delete(s,length(s),1);   // удаляем пробелы в начале и конце строки
    while s[1] = ' ' do delete(s,1,1);
    b := length(s);
    write(b:3,' <',s); // по мере подсчета постепенно выводим, что мы делаем
    if (b < m) and (pos(' ',s) > 0) then begin // если в строке нет пробелов - ничего не поделаешь 
      k := 1; // счетчик внешнего цикла, а заодно - длина последовательности пробелов (сколько пропускать)
      repeat
        j := 1;   // бежим вдоль строки
        while (j < length(s)) and (length(s) < m) do begin
          if s[j] = ' ' then begin  // найдя пробел, вставляем еще один и "перепрыгиваем" через всю последовательность пробелов
            insert(' ',s,j);
            inc(j,k);
          end;
          inc(j);
        end;
        inc(k);
        write(' k=',k);
      until length(s) = m;
      for j:=1 to m do a[i,j]:=s[j];
    end;
    writeln('>');
  end;
  WriteArray;
  readkey;
end.

[Feagor]

спасибо andriano работает!!!!
2client я работаю в FPC и у мну все норм компилится, для TP7 он орет слишком много переменных, попробуй уменьшить количество строк в матрице...при уменьшении от 255 до 25 работает