VPF::Удаление лишних пробулов - Форум программистов

Studeht

Дата 6.4.2009, 16:57 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 27
Регистрация: 6.4.2009
Где: Тула

Репутация: нет
Всего: нет

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

Код


type Mas=array[1..20] of string;

procedure InputData(var S:string; var a:Mas);
var FileIn:text;
    NameFile:string;
    i:integer;
begin
  write('Введите имя входного файла ');
  readln(NameFile);
  assign(FileIn,NameFile);
  {$I-}
  reset(FileIn);
  {$I+}
    if IOResult<>0 then
      begin
        writeln('Ошибка!Файл ',NameFile,' не найден!');
        readln;
        exit;
      end;
    while not Eof(FileIn) do
      begin
        for i:=1 to length(S) do
          begin
            readln(FileIn,a[i]);
            writeln(a[i]);
          end;
      end;
  Close(FileIn);
end;

procedure DeleteSpaces(S:string; a:Mas);
var p,i:integer;
begin
  repeat
    p:=Pos('  ',a[i]);
    if p>0 then Delete (a[i],p,1);
  until p=0;
  if a[1]=' ' then
    Delete(a[i],1,1);
  if a[length(S)]=' ' then
    Delete(a[i],length(S),1);
end;
procedure OutputData(a:Mas);
var NameFile:string;
    FileOut:text;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  rewrite(FileOut);
  writeln(FileOut,a[i]);
  Close(FileOut);
end;

var a:Mas;
    S:string;
begin
  clrscr;
  InputData(S,a);
  DeleteSpaces(S,a);
  OutputData(a);
  readln;
end.

Но программа виснет после ввода имени входного файла.. Помогите исправить эту ошибку

Это сообщение отредактировал(а) Studeht - 6.4.2009, 17:00

volvo877

Дата 6.4.2009, 18:42 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Ты запутал себе все, что только можно запутать. По порядку: Что хранится в файле? Несколько строк? Максимум 20? Тогда читать их надо не так, как ты делаешь, а вот так:

Код

function InputData(var a:Mas): integer;
var
  FileIn:text;
  NameFile:string;
  i:integer;
begin
  write('Введите имя входного файла '); readln(NameFile);
  assign(FileIn,NameFile);
  {$I-}
  reset(FileIn);
  {$I+}
  if IOResult<>0 then begin
    writeln('Ошибка!Файл ',NameFile,' не найден!'); readln; exit;
  end;

  i := 0;
  while not Eof(FileIn) do begin
    inc(i);
    readln(FileIn,a[i]);
    writeln(a[i]);
  end;
  Close(FileIn);

  InputData := i; { <--- Возвращаем число прочитанных строк }
end;

Теперь об удалении пробелов (size - количество строк, прочитанное из файла. То, что вернула функция InputData):

Код

procedure DeleteSpaces(var a:Mas; size: integer);
var p, i: integer;
begin
  for i := 1 to size do begin
    repeat
      p:=Pos('  ',a[i]);
      if p>0 then Delete (a[i],p,1);
    until p=0;
    if a[1]=' ' then Delete(a[i],1,1);
    if a[length(a[i])]=' ' then Delete(a[i],length(a[i]),1);
  end;
end;

Ну, и также в цикле сохранишь измененные строки назад в файл...

Это сообщение отредактировал(а) volvo877 - 6.4.2009, 18:46

Studeht

Дата 6.4.2009, 19:52 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 27
Регистрация: 6.4.2009
Где: Тула

Репутация: нет
Всего: нет

Т.е. вывод такой должен быть:

Код


function OutputData(a:Mas):integer;
var NameFile:string;
    FileOut:text;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  rewrite(FileOut);
  inc(i);
  writeln(FileOut,a[i]);
  Close(FileOut);
  OutputData:=i;
end;

Studeht

Дата 19.4.2009, 12:21 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 27
Регистрация: 6.4.2009
Где: Тула

Репутация: нет
Всего: нет

Здравтвуйте Господа программисты. Помогите реализовать следующую программу с помощью динамических переменных, а то что ни как не могу понять как это сделать smile

Код


type Mas=array[1..50] of string;

procedure InputData(var a:Mas; var n:integer);
var FileIn:text;
    NameFile:string;
begin
  write('Введите имя входного файла ');
  readln(NameFile);
  assign(FileIn,NameFile);
  {$I-}
  reset(FileIn);
  {$I+}
    if IOResult<>0 then
      begin
        writeln('Ошибка!Файл ',NameFile,' не найден!');
        readln;
        halt;
      end;
    n:=0;
    while not Eof(FileIn) do
      begin
        inc(n);
        readln(FileIn,a[n]);
      end;
  Close(FileIn);
end;

procedure DeleteSpacesInString(var S:string);
var p,i:integer;
begin
  for i:=1 to length(S) do
    begin
      repeat
        p:=Pos('  ',S[i]);
        if p>0 then Delete (S,p,1);
      until p=0;
      if S[1]=' ' then
        Delete(S,1,1);
      if S[length(S)]=' ' then
        Delete(S,length(S),1);
    end;
end;

procedure DeleteSpacesInMas(var a:Mas; n:integer);
var i:integer;
begin
  for i:=1 to n do
    DeleteSpacesInString(a[i]);
end;

procedure OutputData(a:Mas; n:integer);
var NameFile:string;
    FileOut:text;
    i:integer;
begin
  write('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  rewrite(FileOut);
  for i:=1 to n do
  writeln(FileOut,a[i]);
  Close(FileOut);
end;

var a:Mas;
    n:integer;
begin
  clrscr;
  InputData(a,n);
  DeleteSpacesInMas(a,n);
  OutputData(a,n);
end.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »