Помогите пожалуйста.
Задание
Что то я не понимаю что от меня хотят, помогите мне

Задача 1

Условие задачи. Разработать программу простейшего редак-тора текстов.
С экрана вводится произвольный текст. Текст построчно со-храняется в файле. Прочитать текст построчно из файла и в ка-ждой строке удалить лишние пробелы между словами, кроме од-ного. Вывести преобразованный текст в другое экранное окно.
Пояснения к решению задачи. Решение задачи с большим объ-емом входной информации, типа многострочного текста, требует обеспечения работы пользователя в более удобной форме, чем обычный ввод данных с клавиатуры компьютера. Чтобы один раз введенный текст не приходилось набирать заново, его предлагается сохранять в файле. Если в условии задачи предлагается работать с текстом, то для работы с текстом надо определить текстовый файл.


Запихиваешь текст в Мемо ( Memo1.Lines.LoadFromFile(filename) ). Потом считываешь построчно, пробегаешь циклом удаляя пробелы, и записываешь новую строку в новый ММемо.
Понятно?

не, не понятно, не могу по алгоритму составить текст функции для удаления лишних пробелов в одной строке текста.
Добавлено @ 18:36
у меня есть первое решение, так мне выдает ошибку после того как текст введен, и не удаляет пробелы

for k:=1 to Memo1.LinesCount do
for i:=1 to Lendth(Memo1.Lines[k]) do
begin
if copy(Memo1.Lines[k],i,1)=' ' then del(Memo1.Lines[k],i,1);
end;

У меня вот как
function Stroka(s:string):string;
var i,k:integer;
begin
k:=length(s);
for i:=1 to k do
while (s[i]=' ') and (s[i+1]=' ') do begin delete(s,i+1,1);
k:=k-1;end;
Stroka:=s;

чуть не дочитал условие . Вроде правильно, что не работает?

не знаю
Вот смотри что у меня:

Код

uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, Menus, StdCtrls, System.ComponentModel; type  TForm1 = class(TForm)    OpenDialog1: TOpenDialog;    MainMenu1: TMainMenu;    N1: TMenuItem;    N2: TMenuItem;    N3: TMenuItem;    N4: TMenuItem;    Label1: TLabel;    Memo1: TMemo;    Label2: TLabel;    Label3: TLabel;    Edit1: TEdit;    Memo2: TMemo;    SaveDialog1: TSaveDialog;    procedure N3Click(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure N4Click(Sender: TObject);    procedure N1Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1;  q,w:string;  f,f1:textfile;  j,p:integer; implementation {$R *.dfm} function Stroka(s:string):string; var i,k:integer; begin k:=length(s); for i:=1 to k do while (s[i]=' ') and (s[i+1]=' ') do begin delete(s,i+1,1); k:=k-1;end; Stroka:=s; end; procedure TForm1.N3Click(Sender: TObject); begin Application.Terminate; end; procedure TForm1.FormCreate(Sender: TObject); begin memo1.Clear; memo2.Clear; edit1.Text:=''; if opendialog1.Execute then w:=opendialog1.filename; assignfile(f,w); if fileexists(w) then begin reset(f); memo1.Clear; edit1.Text:=OpenDialog1.Files.DelimitedText; while eof(f)<>true do begin readln(f,q); memo1.lines.Append(q);end; closefile(f); end else showmessage('Найдите файл!!!'); end; procedure TForm1.N4Click(Sender: TObject); begin j:=memo1.Lines.Capacity; memo2.Clear; for p:=0 to j do memo2.Lines.Append(stroka(memo1.Lines.Strings[p])); end; procedure TForm1.N1Click(Sender: TObject); begin if SaveDialog1.Execute then  q:=SaveDialog1.FileName; assignfile(f1,q); rewrite(f1); j:=memo1.Lines.Capacity; for p:=0 to j do writeln(f1,memo1.lines.strings[p]); closefile(f1) end; end.

вместо while надо if
Добавлено @ 18:56
алгоритм правильный: найти пробел - если за ним еще пробел то удалить предыдущий и вернуть позицию на 1 назад

Удаление двойных пробелов:

Код

while pos('  ',s)>0 do s:=ReplaceString(s, '  ',' ',[rfReplaceAll])

Добавлено @ 05:07
Не самое лучшее решение...

Код

procedure TForm1.N3Click(Sender: TObject); begin Application.Terminate; end;

Лучше так:

Код

procedure TForm1.N3Click(Sender: TObject); begin  Close; end;

есть решение:
for i:=1 to Memo1.LinesCount do
begin
for j:=1 to length( Memo1.Lines[i]) do
begin
if copy(memo1.Lines[i],j,1)=' ' and copy(memo1.Lines[i],j+1,1)=' '
then delete(memo1.Lines[i],j+1,1);
end;
Memo2.Lines[i]:=Memo1.Lines[i];
end;

Vladimir13, хех... а ошибок то в этом коде... проверяйте границы массивов, потом вылавливать такие ошибки замучаешся - их лучше такие не делать. Да и алгоритм работать будет со сбоями...

можно поставить условие
if j= length( Memo1.Lines[i]) and copy(memo1.Lines[i],j,1)=' ' then memo2.Lines[i]:=Memo1.Lines[i]

У меня выходит когда хочу запусть на исполнение : Invalid threading model (STAThreadATTribute is required)
потом когда ввожу текст, потом записать пытаюсь тогда ошибка : index was outside the bonus of the array

Это сообщение отредактировал(а) Yanochka - 19.12.2004, 22:41

что то лучше чем ничто. Прежде чем критиковать - убедись, что то, что ты предложил работает. а мое и подработать можно при желании

Цитата(Yanochka @ 19.12.2004, 13:39)

У меня выходит когда хочу запусть на исполнение : Invalid threading model (STAThreadATTribute is required) потом когда ввожу текст, потом записать пытаюсь тогда ошибка : index was outside the bonus of the array

А что ты делаешь? И смысл задачи? Это учебная задача или реальная? Если учебная то алгоритм будет такой:

Код

s:=memo1.text;  while pos('  ',s)>0 do Delete(s,pos('  ',s),1);  memo1.Text:=s;

Если реальная то я уже дал тебе решение:

Код

while pos('  ',memo1.text)>0 do memo1.text:=ReplaceString(memo1.text, '  ',' ',[rfReplaceAll])

Добавлено @ 02:12

Цитата(Vladimir13 @ 19.12.2004, 16:57)

что то лучше чем ничто. Прежде чем критиковать - убедись, что то, что ты предложил работает. а мое и подработать можно при желании

Подработать можно, но очень сложно, код неправильно изначально разработан, доработать - это его заново переписать, а решение я уже давал, вот и ещё раз даю...