Помощь - Поиск - Пользователи - Календарь
Полная версия: Обработка файла
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Jaxx
Добрый день.
Программированием начал заниматься недавно (причем по учебе). учусь в универе на программиста, и мне нужно написать курсовую на Паскале. А у меня ничего не получается, так что, если Вам не тяжело, то помогите чем сможете - мне всего 1 прогу нужно накатать.
Задание такое:
Разработать программу "Выравнивание". Исходная информация: текст,
записанный в текстовом файле. Программа выводит этот текст с
выравниванием по краям. Тескт выводится без переносов слов. Параметры
абзаца задаются в диалоговом режиме.
Заранее очень благодарен !
Altair
Код
Program FORMAT_TEXT;
Uses Crt;
Var
I:longint; {­®¬Ґа н«-в  вҐЄбв®ў®Ј® д « }
F:File of byte; {д ©« ⥪бв®ўл©, Є ¦¤л© н«-в -Є®¤ ASCII }
filename:string;{Їгвм Є д ©«г}
el,ke,j,otst,g:byte;
{
  el  - Є®¤ бЁ¬ў®« , ўлў®¤Ё¬®Ј® ­  нЄа ­
  ke  - ¤«Ё­­  ўлў®¤Ё¬ле бва®Є
  j   - бзҐвзЁЄ, ­Ґ®Ўе®¤Ё¬л© ¤«п бў®ҐўаҐ¬Ґ­­®Ј® ЇҐаҐў®¤  Є аҐвЄЁ
  otst- ®вбвгЇ ®в Єа п нЄа ­ 
  g   - бзҐвзЁЄ, ®в¬ҐапойЁ© «Ґўго Ја ­Ёжг
}
Begin
ClrScr;
Write('‚ўҐ¤ЁвҐ Ё¬п зЁв Ґ¬®Ј® д ©« :'); readln(filename);
Assign(F,filename);
{$I-} reset(f); {$I+}
If IOResult<>0 then
begin
 {Їа®Ё§®и«  ®иЁЎЄ  ЇаЁ ®вЄалвЁЁ д ©«  ... }
 writeln('ERROR - FILE NOT FOUND OR UNKNOWN ERROR');
 halt {§ ўҐа襭ЁҐ а Ў®вл Їа®Ја ¬¬л}
end;
Write('ўўҐ¤ЁвҐ ¤«Ё­­г бва®Є, ўлў®¤Ё¬ле ­  нЄа ­ ');
readln(ke);
write('ўўҐ¤ЁвҐ ®вбвгЇ ®в ЏђЂ‚Ћ‰ Ја ­Ёжл нЄа ­ ');
readln(otst);
writeln;
{¤Ґ« Ґ¬ 1 ®вбвгЇ}
for g:=1 to otst do write(' ');
{зЁв Ґ¬ д ©« ...}
for I:=1 to filesize(f) do
begin
 {ЇҐаҐў®¤Ё¬ ­  ®зҐаҐ¤­®© н«-в}
 seek(f,(I-1));
 {зЁв Ґ¬ н«-в}
 read(f,el);
 {ўлў®¤Ё¬ бЁ¬ў®« ­  нЄа ­, Ґб«Ё нв® ­Ґ гЇа ў«пойЁҐ б¬Ёў®«л}
 If (el<>13) and (el<>10) then begin write(CHR(el)); inc(J,1) end;
 {ЇҐаҐў®¤Ё¬ Є аҐвЄг, ¤Ґ« Ґ¬ ®вбвгЇ}
 If J=ke then
 begin
  J:=0;
  writeln;
  for g:=1 to otst do write(' ')
 end;
end;
writeln('ђ Ў®в  Їа®Ја ¬¬л § ўҐа襭 , ­ ¦¬ЁвҐ «оЎго Є« ўЁиг...');
{¦¤Ґ¬ ­ ¦ вЁп Є« ўЁиЁ, ¬®¦­® § ¬Ґ­Ёвм ­  readkey}
while not keypressed do;
end.

Если есть вопросы, задавайте.
Jaxx
Ну спасибо. Прога работает нормально. Но есть недостаток, причем довольно существенный. В условии сказано, что текст выводится без переносов. А эта прога разрывает слова. Если есть возможность, подскажите как исправить.
Altair
можно так сделать, но это сложнее, надо не просто переносить каретку после набегания счетчика, но смотреть чтобы пробел был!
Jaxx
А вот как это сделать ? Со сложностью проблем нет - я как нибудь разберусь.
А как убрать переносы - не знаю. Я так понимаю, что в цикле нужно сделать проверку последнего символа, и если он окажется буквой, то что с ним делать?
Ведь нужно будеть растянуть строку по ширине, а значит между словами вставить дополнительные пробелы.
Altair
Так, а как правилно, так (выводим строки длинной 18):

фыфпвап вапф варыа (в этой строке 18 сиволов, не считая скобку)
аврвар ыварваор врывар
ывар ырыпарыва ывр
ыавп варвар варвар

И добавить пробелы между словами, или надо так (выводим по 18, если не умещаеться, то все слово переносим):

фыфпвап вапф варыа
аврвар ыварваор
врывар ывар
ырыпарыва ывр ыавп
варвар варвар

а потом добавляем пробелы между словами.
----
Это принципиально важно.
В первом случае мы после набегания счетчика строки переводим каретку после конца слова.
(т.е. к коду надо добавить проверку конца слова, это не сложно)
А во втором случае, надо каким-то образом узнавать уместится ли слово на строке или его уже надо переносить.

----
2 способ значительно сложнее, но более правильный (как мне кажется).
Jaxx
Мне честно говоря, больше нравится естественно второй способ, но мне от этого легче не становится.
А если попробовать так – ширина экрана равна 80 символов (т.е. макс. длина строки тоже 80). Пользователь задаёт отступ справа (напр. 3 символа), и длину строки (напр. 76 символов). И если длина первой строки файла превышает 76, то тогда нужно сделать проверку на перенос. Проверку можно сделать так: берем последний (76-й) символ в строке, и если это пробел, то идем дальше, а сели это буква, то перебираем все символы с конца до тех пор, пока не найдем пробел. Найденный пробел делаем последним символом строки, а расстояние между этим пробелом и последней буквой в строке равномерно (по возможности) распределяем между остальными пробелами в строке (но так, чтобы этот найденный пробел был последним символом и не выводился на экран).
На словах вроде не особливо сложно, но написать я попрошу все-таки Вас (если можно).
Altair
Цитата
Мне честно говоря, больше нравится естественно второй способ

Второй и сделаем!
Jaxx
Буду премного благодарен за оказанное содействие.
Ибо сам я не особый гений прграммирования (может просто опыта маловато) sad.gif

Добавлено (30.04.04 14:10):
Нужно довольно срочненько !!!

Добавлено (8.05.04 10:16):
Про меня что, все забыли совсем? Это же курсовая. Обратиться мне больше не к кому. Неужели не поможете ?
BlackShadow
6 минут работы, и вот результат... Вроде то, если что не так - пиши

Код

Var
 f:Text;
 n,i:Integer;
 s,s2:String;

const
 Delimiters=[' ',',','.','!','?',';',':'];

Begin
 Write('Enter Length Of String: ');
 ReadLn(n);
 Assign(f,'In.Txt');
 Reset(f);
 s:='';
 While Not Eof(f) Do
 Begin
   While (Not Eof(f)) And (Length(s)<n) Do
   Begin
     ReadLn(f,s2);
     s:=s+' '+s2
   End;
   If Length(s)>n Then
   Begin
     For i:=n DownTo 1 Do
       If s[i] In Delimiters Then
         Break;
     WriteLn(Copy(s,1,i));
     Delete(s,1,i)
   End
   Else
   Begin
     WriteLn(s);
     s:=''
   End
 End;
 Close(f)
End.
Jaxx
Вот пишу. Ибо что-то не то. У меня программа почему-то выводит только часть текстового файла, а не весь. Во-вторых, я может недоговорил насчет условия.
Понимаете, нужно чтобы текст выравнивался по ширине, как в Word, то есть
никаких разрывов слов, а между словами доставить пробелы так, чтобы последним символом в строке была буква или запятая или еще что но целиком.
Программа нужна обязательно в течение недели.
Спасибо тем кто ответил хотя бы за сочувствие...
Altair
Я за выходные попробую дописать ту, что сначала писал.
Не стоит отчаиваться.
Jaxx
Очень надеюсь, а то столько проблем с этим пограммированием.
Ну неуч я, неуч...Что же я могу сделать. Тяжело мне дается эта наука.
Altair
Код

Program FORMAT_TEXT;
Uses
CRT,GRAPH;
Var
FileName:string;
F:file of byte;
LG,PG:byte;
slovo,s:string;
c,i:byte;
{----------}
Procedure _LG(o:byte); {Їа®жҐ¤га  ¤Ґ« Ґв ®вбвгЇ}
var
m:byte;
begin
for m:=1 to o do write(' ')
end;
{----------}


{Ћб­®ў­ п Їа®Ја ¬¬ }
Begin
repeat
 ClrScr;
 Writeln('‚ўҐ¤ЁвҐ Ё¬п ®Ўа Ў влў Ґ¬®Ј® д ©« '); Readln(FileName);
 Write('ЋвбвгЇ б«Ґў ='); readln(LG);
 Write('¤«Ё­­  ўлў®¤Ё¬®© бва®ЄЁ='); readln(PG);
 ClrScr;
 Assign(F,FileName);
 {$I-} Reset(F); {$I+}
Until IOResult=0;
While Not EOF(F) do
begin
 read(F,c);
 If (C<>10) and (C<>13) then
 begin
  If C<>32 then slovo:=slovo+CHR(C);
  If C=32 then
  begin
   If ORD(s[0])+ORD(slovo[0])+1<=PG then
   begin
    If ORD(S[0])<>0 then s:=s+' '+slovo;
    If ORD(S[0])=0 then s:=s+slovo
   end;
   IF ORD(s[0])=pg then begin {!}_LG(LG); writeln(s); s:=''; s:=s+slovo end;
   If ORD(s[0])+ORD(slovo[0])>PG then
   begin {!}_LG(LG); writeln(s); S:=''; s:=s+slovo end;
   slovo:='';
  end
 end
end; {While not eof(F)}
_LG(LG);  Writeln(slovo);
end.



Занчит так, все работает, только еще не сделал дополнения пробелами.
Но теперь прога не разрывает слова, и все ОК.
Есть у кого идеи как красиво увеличить длинну строки, вставив в нее пробелы?
APAL
Высчитать сколько не хватает пробелов. И более-менее равномерно распределить между словами. smile.gif
trminator
Может, если нужно вставлять СЛИШКОМ много пробелов между словами, то вставлять их между буквами?
Цитата
О т о р и н о л а р и н г о л о г и ч е с к и й    а в т о в ы ч и с л и т е л ь

Таких слов в строку влезет только два, ставить между ними десяток пробелов некрасиво =)
Altair
Цитата
Высчитать сколько не хватает пробелов. И более-менее равномерно распределить между словами. 

Так известно сколько надо пробеллов, но как их красиво распределить?
Jaxx
Предлагаю свой вариант решения. По моему работает правильнее чем предыдущие. Последний вариант, предложенный Oleg_Z некоторые слова из текста выводит по 2 раза, почему я так и не понял. мой вариант меньше и работает нормально. К нему осталось добавить разделение лишних пробелов между остальными в строке.
Код

program format;
uses crt;
var
filename,slovo,stroka:string;
f:text;
dlina,otstup,i:byte;
simvol:char;
begin
slovo:=' ';
repeat
clrscr;
write('введите имя файла :'); readln(filename); write('введите отступ :'); readln(otstup); write('введите длину строки :'); readln(dlina); clrscr;
assign(f,filename);
reset(f);
until ioresult=0;
write(' ':otstup);
while not eof(f) do begin
read(f,simvol);
if ord(simvol)<>10 then begin
if simvol<>' ' then slovo:=slovo+simvol
else begin
if (length(stroka)+length(slovo))>dlina then begin stroka:=' ';
writeln;
write(' ':otstup);
end;
stroka:=stroka+slovo+simvol;
write(slovo,simvol);
slovo:=' ';
end;
end
else begin
write(slovo);
write(' ':otstup);
slovo:=' ';
stroka:=' ';
end;
end;
close(f);
readkey;
end.
GLuk
Собственно идея следующая:

Предложение: Dos Navigator лучшая оболочка в мире.

Всего имеем 5 пробелов, вставить нужно 20. Дык вот и пляшем от левого края, вставляя по пробелу на каждое пустое место. Вставили первые 5 пробелов, возвращаемся к первому и т.д. Смотрится довольно сносно..
Jaxx
ну вроде смотрится нормально...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.