текстовой файл, перенос Опции

[Work Group]

можете пожайлуста помочь с задачей....я её сделал,но препод не принял..сказал всё переделать...

задача заключается втом, чтобы мы бради тестовой файл,задали сколько символов должно быть в строчках,и всё переписали в новый текстовой файл,с n символов в строчках...и если у нас строчка 10 символов,а мы взяли n=4,то он нам должен выдать две строчки по 4 символа, и одну строчку с 2-мя...

что от меня теперь требуют...чтобы сразу открывали 2 текстовых файла, задали n,и начали по-символьно переносить из одного в другой..когда у нас в новым строчка станет из n символов,то там у нас будет переход на новую строчку...вот как-то так...

если кому интересно,вот что было у меня...

Код

uses crt;
function fcopy(a:string; x,y:word):string; //copy function
  var i,j:byte;
  Begin
    j:=1;
    Setlength(result,(y-x+1));
    if (y>length(a)) then Setlength(result,length(a));
    for i:=x to y do
      begin
       result[j]:=a[i];
        inc(j);
      end;
  End;

function fdelete(var a:string; x,y:word):boolean;  //delete function
  var i,j:byte;
      b:string;
  Begin
    j:=1;
    Setlength(b,(length(a)-y+x-1));
   for i:=1 to length(a) do
      begin
        if ((i<x) or (i>y)) then
          begin
            b[j]:=a[i];
            inc(j);
          end;
      end;
    a:=b;
    result:=true;
  End;

var t,f:text;
    t1,t2,g,a: string;
    n:integer;


BEGIN
   //writeln ('введите путь к файлу');
   //readln (t1);
   t1:='H:\t.txt';
   //writeln ('введите путь к новому файлу');
  //readln (t2);
  t2:='H:\t1.txt';
  //writeln ('введите длинну строк');
   //readln(n);
  n:=5;
  assign(t,t1);
  reset(t);
  assign(t,t1);
  reset(t);
  assign(f,t2);
  rewrite(f);

  while not eof(t)
do
    begin
      a:='';
      readln(t,a);
      while length(a)>n do
        begin
          g:='';
          g:=fcopy(a,1,n);
          fdelete(a,1,n);
          writeln(f,g);
        end;

    end;

  close (f);
  close (t);

END.