Text38. Дано целое число $$K$$ $$(> 25)$$ и текстовый файл, содержащий текст, выровненный по левому краю. Абзацы текста отделяются друг от друга одной пустой строкой. Отформатировать текст так, чтобы его ширина не превосходила $$K$$ позиций, и выровнять текст по левому краю, сохранив деление на абзацы. Пробелы в конце строк удалить. Сохранить отформатированный текст в новом текстовом файле.
Решение:
Перенос по символам, если перенос попадает на середину слова то слово переносится частично.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
program Text38; var F_in,F_out: Text; Name,S2,S1,TempString,line:string; K:integer; Procedure CutString(len:integer;var S,SCut:String); begin SCut:=Copy(S,1,len); Delete(S,1,len); end; begin Write('File name in: '); Readln(Name); Assign(F_in,Name); Write('File name out: '); Readln(Name); Assign(F_out,Name); Write('K: '); Readln(K); Reset(F_in); Rewrite(F_out); Readln(F_in,S1); TempString:=''; While not eof(F_in) do begin S2:=S1; Readln(F_in,S1); TempString:=TempString+' '+S2; While (length(TempString)>=K) do begin CutString(K,TempString,line); Writeln(F_out,line); end; if S1='' then begin Writeln(F_out,TempString); TempString:=''; Writeln(F_out); end; end; Close(F_in); TempString:=TempString+' '+S1; While (length(TempString)>=K) do begin CutString(K,TempString,line); Writeln(F_out,line); end; Close(F_out); end. |
Перенос по словам:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 |
program Text38; var F_in,F_out: Text; Name,S2,S1,TempString,line:string; K:integer; Procedure CutString(len:integer;var S,SCut:String); begin if (pos(' ',S)>len) or ((pos(' ',S)=0) and (length(S)>len) ) then begin SCut:=Copy(S,1,len); Delete(S,1,len); end else begin if (pos(' ',S)=0) then begin SCut:=S; S:=''; end else begin SCut:=''; while (length(SCut+Copy(S,1,pos(' ',S)-1))<=len) do begin if SCut<>'' then SCut:=SCut+' '; SCut:=SCut+Copy(S,1,pos(' ',S)-1); Delete(S,1,pos(' ',S)); end; end; end; end; begin Write('File name in: '); Readln(Name); Assign(F_in,Name); Write('File name out: '); Readln(Name); Assign(F_out,Name); Write('K: '); Readln(K); Reset(F_in); Rewrite(F_out); Readln(F_in,S1); S1:=''; TempString:=''; While not eof(F_in) do begin S2:=S1; Readln(F_in,S1); if length(s1)>0 then While (S1[Length(S1)]=' ') and (length(s1)>0) do Delete(S1,Length(S1),1); if S2<>'' then TempString:=TempString+' '+S2; While (length(TempString)>=K) do begin CutString(K,TempString,line); Writeln(F_out,line); end; if S1='' then begin if TempString<>'' then Writeln(F_out,TempString); TempString:=''; Writeln(F_out); end; end; Close(F_in); TempString:=TempString+' '+S1; While (length(TempString)>=K) do begin CutString(K,TempString,line); Writeln(F_out,line); end; Close(F_out); end. |
Другие задачи из раздела Text можно посмотреть здесь.
Первый вариант едва ли соответствует заданию , а во втором куда-то теряются начальные строки из исходного файла.
Могу такой предложить :