задача такова дана символьная матрица матрица 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.
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;
Размер принято указывать в виде (размер по X)[*|x](размер по Y). Мы же не говоим 480x640 или 1024x1280.
че-то все перепроверил все равно не работает, почему то тупо в конец дорисовывает пробелы=(
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.
спасибо andriano работает!!!!
2client я работаю в FPC и у мну все норм компилится, для TP7 он орет слишком много переменных, попробуй уменьшить количество строк в матрице...при уменьшении от 255 до 25 работает