Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Обработка файла

Автор: Jaxx 24.04.2004 17:05

Добрый день.
Программированием начал заниматься недавно (причем по учебе). учусь в универе на программиста, и мне нужно написать курсовую на Паскале. А у меня ничего не получается, так что, если Вам не тяжело, то помогите чем сможете - мне всего 1 прогу нужно накатать.
Задание такое:
Разработать программу "Выравнивание". Исходная информация: текст,
записанный в текстовом файле. Программа выводит этот текст с
выравниванием по краям. Тескт выводится без переносов слов. Параметры
абзаца задаются в диалоговом режиме.
Заранее очень благодарен !

Автор: Altair 24.04.2004 18:07

Код
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 25.04.2004 14:06

Ну спасибо. Прога работает нормально. Но есть недостаток, причем довольно существенный. В условии сказано, что текст выводится без переносов. А эта прога разрывает слова. Если есть возможность, подскажите как исправить.

Автор: Altair 25.04.2004 14:31

можно так сделать, но это сложнее, надо не просто переносить каретку после набегания счетчика, но смотреть чтобы пробел был!

Автор: Jaxx 25.04.2004 16:19

А вот как это сделать ? Со сложностью проблем нет - я как нибудь разберусь.
А как убрать переносы - не знаю. Я так понимаю, что в цикле нужно сделать проверку последнего символа, и если он окажется буквой, то что с ним делать?
Ведь нужно будеть растянуть строку по ширине, а значит между словами вставить дополнительные пробелы.

Автор: Altair 25.04.2004 18:26

Так, а как правилно, так (выводим строки длинной 18):

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

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

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

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

----
2 способ значительно сложнее, но более правильный (как мне кажется).

Автор: Jaxx 25.04.2004 19:46

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

Автор: Altair 26.04.2004 10:54

Цитата
Мне честно говоря, больше нравится естественно второй способ

Второй и сделаем!

Автор: Jaxx 26.04.2004 23:24

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

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

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

Автор: BlackShadow 8.05.2004 15:22

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 15.05.2004 0:56

Вот пишу. Ибо что-то не то. У меня программа почему-то выводит только часть текстового файла, а не весь. Во-вторых, я может недоговорил насчет условия.
Понимаете, нужно чтобы текст выравнивался по ширине, как в Word, то есть
никаких разрывов слов, а между словами доставить пробелы так, чтобы последним символом в строке была буква или запятая или еще что но целиком.
Программа нужна обязательно в течение недели.
Спасибо тем кто ответил хотя бы за сочувствие...

Автор: Altair 15.05.2004 2:03

Я за выходные попробую дописать ту, что сначала писал.
Не стоит отчаиваться.

Автор: Jaxx 15.05.2004 14:39

Очень надеюсь, а то столько проблем с этим пограммированием.
Ну неуч я, неуч...Что же я могу сделать. Тяжело мне дается эта наука.

Автор: Altair 15.05.2004 21:59

Код

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 15.05.2004 22:19

Высчитать сколько не хватает пробелов. И более-менее равномерно распределить между словами. smile.gif

Автор: trminator 15.05.2004 22:37

Может, если нужно вставлять СЛИШКОМ много пробелов между словами, то вставлять их между буквами?

Цитата
О т о р и н о л а р и н г о л о г и ч е с к и й    а в т о в ы ч и с л и т е л ь

Таких слов в строку влезет только два, ставить между ними десяток пробелов некрасиво =)

Автор: Altair 15.05.2004 23:35

Цитата
Высчитать сколько не хватает пробелов. И более-менее равномерно распределить между словами. 

Так известно сколько надо пробеллов, но как их красиво распределить?

Автор: Jaxx 17.05.2004 0:12

Предлагаю свой вариант решения. По моему работает правильнее чем предыдущие. Последний вариант, предложенный 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 17.05.2004 0:12

Собственно идея следующая:

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

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

Автор: Jaxx 17.05.2004 23:30

ну вроде смотрится нормально...