Алфавитный порядок слов.., запутался Опции

[b0b]

вечер добрый.
задачка такая.

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

написал процедуру открытия файла:

procedure open(var f:text);
var name:string[40];
    ok:boolean;
begin
  repeat
    write('Vvedite name of file: ');
    readln(name);
    assign(f,name);
    {$i-}reset(f); {$i+}
    ok:=IOResult=0;
  until ok=true;
end;

и процедуру чтения слов из файла:

procedure word(var f:text; var w:string);
var ch:string;
begin
  repeat
    readln(f,ch);
  until ch <> ' ';
    w:='';
    repeat
      w:=w+ch;
      readln(f,ch);
    until (ch=' ') or (eoln(f)) or (eof(f));
    if ch <> ' ' then w:=w+ch;
    if eoln(f) then readln(f);
end;

а вот дальше чет немогу...
нужно срочно..

Сообщение отредактировано: b0b - 5.12.2005 1:24

[volvo]

А дальше - все слова с заданной длиной пишешь в массив строк, потом сортируешь массив по возрастанию любым способом отсюда: FAQ: Методы сортировок
и распечатываешь...

[b0b]

А дальше - все слова с заданной длиной пишешь в массив строк, потом сортируешь массив по возрастанию любым способом отсюда: FAQ: Методы сортировок
и распечатываешь...

отсортировать, я думаю, смогу.
не могу понять, как в, допустим, w (string) из s добавить только слова заданной длины n.

[volvo]

Погоди, у тебя же есть процедура чтения слов... Что, нельзя после получения очередного слова проверить его длину? Как-то вот так:

var
  arr: array[1 .. 200] of string[50];
  count: integer;
  next_word: string;
...
{ открываем файл, запрашиваем чему равно N ... }
  count := 0;
  while not eof(f) do begin

    GetWord(f, next_word); { это твоя функция чтения слов из файла }
    if length(next_word) = n then begin
      { добавляем слово в массив }
      inc(count); arr[count] := next_word;
    end;

  end;

  { и сортируем массив }
...

[b0b]

Погоди, у тебя же есть процедура чтения слов... Что, нельзя после получения очередного слова проверить его длину? Как-то вот так:

да, чтения слов.
но читает она посимвольно..или это не имеет значения?

[volvo]

А какая разница? Получаешь-то ты все равно строку...

[b0b]

А какая разница? Получаешь-то ты все равно строку...

да. посимвольно. допустим, составили слово "test", затем "fire". записали их в строку. а каким образом проверить, 4 они символа или нет, если записываем посимвольно.
бр..запутался

[volvo]

На мой пример посмотри ... Записывать не в строку, а в массив строк...

[b0b]

На мой пример посмотри ... Записывать не в строку, а в массив строк...

теперь запутался с процедурой чтения слов..

[b0b]

program 2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var f1:text;
    n,count,i,k:integer;
    s:string;
    arr:array[1..200] of string[50];
    next_word:string;

procedure open(var f:text);
var name:string[40];
    ok:boolean;
begin
  repeat
    write('Vvedite name of file: ');
    readln(name);
    assign(f,name);
    {$i-}reset(f); {$i+}
    ok:=IOResult=0;
  until ok=true;
end;

procedure word(var f:text; var w:array of string);
var ch:string;
begin
  repeat
    readln(f,ch);
  until ch <> ' ';
    w[i]:='';
    repeat
      w[i+1]:=w[i]+ch;
      readln(f,ch);
    until (ch=' ') or (eoln(f)) or (eof(f));

    if ch <> ' ' then w[i+1]:=w[i]+ch;
    if eoln(f) then readln(f);
end;
begin
   write('Vvedite dlinu: ');
   readln(n);

   open(f1);
   writeln;

   count:=0;
   while not eof(f1) do begin
    word(f1,next_word);
    if length(next_word) = n then begin
      inc(count); arr[count]:=next_word;
    end;

end;
 readln;
end.

вот все собрал. бардак какой-то получился .
непашет нифига..

[volvo]

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

uses
  SysUtils;

type
  t_string = string[50];

var
  f1:text;
  n,count,i,k:integer;
  s:string;
  arr:array[1 .. 200] of t_string;
  next_word: t_string;

procedure open(var f:text);
var
  name:string[40];
  ok:boolean;
begin
  repeat
    write('Vvedite name of file: ');
    readln(name);
    assign(f,name);
    {$i-} reset(f); {$i+}
    ok:=IOResult=0;
  until ok=true;
end;

procedure word(var f:text; var w: t_string);
var ch:char;
begin
  repeat
    read(f,ch);
  until ch <> ' ';

  w := '';
  repeat

    w := w + ch;
    read(f, ch);
    if (ch = #32) or eof(f) or eoln(f) then break;

  until false;

  if ch <> ' ' then w := w + ch;
  if eoln(f) then readln(f);

end;

begin
   write('Vvedite dlinu: ');
   readln(n);

   open(f1);
   writeln;

   count:=0;
   while not eof(f1) do begin

    word(f1,next_word);
    writeln('read from file: ', next_word);
    if length(next_word) = n then begin
      inc(count); arr[count]:=next_word;
    end;

   end;

   for i := 1 to count do writeln(arr[i]);
   readln;
end.

[b0b]

volvo, крепко жму лапу. . спасибо.