Создание списка слов Опции

[annie]

Плз,помогите кто-нить с задачкой!Вначале была задача слова в строке отсортировать по алфавиту и по колву букв.Это я сделала.Потом нада исх строу сохранить в текстовом файле - это я тож сделала.А потом нада список слов сохранит в файле..а как сделать из массива слов список слов??HELP ???

uses crt;
type stroka=record
     clovo:string[80] end;
fslov=file of stroka;
arrslov=array[1..100] of stroka;
arr=array[1..100]of string[80];


procedure enter(var s:string);     {ввели строку}
          begin
          write('Vvedite stroky:');readln(s) end;

procedure save1(fn:string;s:string);  {сохранили строку}
          var f:text;i:integer;
          begin assign(f,fn);
          rewrite(f);
          write(f,s);
          close(f);
          writeln('Save Is Done!!!') end;

procedure words(s:string;var y:arr;var k:integer);
{разбили строку на слова и создали массив из слов}
          var i:integer;slovo:string;
          begin i:=1;k:=0;
          while i<=length(s) do
          begin slovo:='';
          while (s[i] in ['A'..'Z'])or(s[i] in ['a'..'z']) do
          begin slovo:=slovo+s[i];i:=i+1;end;
          k:=k+1;y[k]:=slovo;
          while not((s[i] in ['A'..'Z'])or(s[i] in ['a'..'z']))do
          i:=i+1;
          end;
          end;

procedure save2(fn:string;y:arrslov;n:integer);
{сохранили список слов}
          var f1:fslov;i:integer;
          begin assign(f1,fn);
          rewrite(f1);
          for i:=1 to n do
          write(f1,y[i]);
          close(f1);
          writeln('Save Is Done!!!') end;

procedure load1(fn:string;var s:string);
{загрузили исх строку}
          var f:text;
          begin
          assign(f,fn);reset(f);
          while not eof(f) do begin
          read(f,s);end;
          close(f);end;

procedure sort(x:arr;nx:integer;var y:arr);
{сортировка по колву букв}
          var i,j:integer;tmp:string;
              begin y:=x;
          for i:=1 to nx-1 do
                    for j:=i+1 to nx do
                    if length(y[i])>length(y[j]) then
    begin tmp:=y[i];y[i]:=y[j];y[j]:=tmp;end;
    end;

procedure sort2(x:arr;nx:integer;var y:arr);
{сортировка по алфавиту}
          var i,j:integer;tmp:string;
              begin y:=x;
          for i:=1 to nx-1 do
                    for j:=i+1 to nx do
                    if y[i]>y[j] then
     begin tmp:=y[i];y[i]:=y[j];y[j]:=tmp;end;
     end;

procedure slova(x:arr;nx:integer);
{вывод массива слов}
          var i:integer;
          begin for i:=1 to nx do
          write(x[i],#32) end;

procedure load2(fn:string;var z:arrslov;var n:integer);
{загрузить список слов из файла}
          var f1:fslov;
          begin n:=0;
          assign(f1,fn);reset(f1);
          while not eof(f1) do begin
          read(f1,z[n+1]);n:=n+1 end;
          close(f1);
          end;

procedure vivod(z:arrslov;n:integer);
{вывод списка слов}
          var i:integer;
          begin for i:=1 to n do
          writeln(z[i].clovo:10);
          end;

function fname:string;
         var s:STRING;
         begin write('Vvedi FileName:');readln(s);
         fname:=s end;

var my:string;n,k:integer;word,srtwrd:arr;flag:integer;slv:arrslov;
    begin textcolor(4);
    repeat                                                                    
    clrscr;
writeln('1-Vvod,2-Vivod,3-Save1,4-load1,'+
  '5-slova,6-save2,7-load2,8-_sort,Esc-Quit');

    case readkey of
    '1':enter(my);
    '2':writeln(my);
    '5':begin words(my,word,n);
              slova(word,n) end;
    '8':begin write('1-po kolvy bykv,0-po alfavity');
              writeln('flag=');
              readln(flag);
              if flag=1 then
        begin sort(word,n,srtwrd);slova(srtwrd,n) end
               else
        begin sort2(word,n,srtwrd);slova(srtwrd,n) end;
        end;
    '3':save1(fname,my);
    '4':begin load1(fname,my); writeln(my)end;
    '6':save2(fname,slv,k);
     '7':begin load2(fname,slv,k);vivod(slv,k) end;

  #27:exit;end;
  readkey  until false;
  end.

[DI]

я вобщето не специалист,но зачем из массива слов делать список слов.Не лучше ли записывать в файл(текстовый) каждый элемент массива в цикле

var
arr:array[1..100]of string;
i:integer;
g2:text;
begin
assign(g2,'1.txt');
append(g2);
while i<=100 do
begin
writeln(g2,arr[i]);
flush(g2);
inc(i);
end;
end;

извиняюсь , что не просмотрел прогу,поэтому переменные бери свои.