Помогите решить задачку
Вводится произвольное кол-во слов в строку, программа выводит кол-во слов в строке и переставляет местами слова (1 со 2, 3 с 4 и т.д), если перед первым словом пробел, или между словами более одного пробела, то выдается сообщение о ошибке и предлагается начать сначала.

//в строке переставить местами рядом стоящие слова(1 со 2, 3 с 4, и т.д.) Дана
//дана строка, нач. не пробелом, между словами по 1 пробелу,
//и строка закан. буквой

program ctroca;
{$APPTYPE CONSOLE}
uses
SysUtils;
var s,s1,temp:string;
s2:array[1..25]of string;
p,k,n,i,t:integer;
begin
writeln('Vvedite text');
readln(s);
writeln;
k:=1;
n:=1;
p:=0;
s1:='';

for i:=1 to length(s) do
begin
if (s[i]<>' ')and(s[i+1]=' ')
then inc(k);
end;

for i:=1 to length(s) do
begin
if (s[i]<>' ')
then begin
insert(s[i],s1,n);
inc(n);
end;
if (s[i]=' ') or (i=length(s))
then begin
n:=1;
inc(p);
s2[p]:=s1;
s1:='';
end;
end;

if

for i:=1 to length(s) do
if (s[i]=' ') and (s[i+1]=' ')
then begin
writeln('Error!!!!');
s:='';
writeln('Mnogo probelov ');
writeln('Vvedite text :');
readln(s);
for i:=1 to Length(s) do
begin
if (s[i]<>' ')and(s[i+1]=' ')
then inc(k);
end;
end;
end;

if s[1]=' '
then begin
writeln('Error!!!!');
writeln('Nachalo probel ');
writeln('Vvedite text :');
readln(s);
for i:=1 to Length(s) do
begin
if (s[i]<>' ')and(s[i+1]=' ')
then inc(k);
end;
end;
writeln('Kol-vo slov: ',k);

readln;
end.

1. Пользуйся тэгами.
2. Приведи пример строки, которая на входе, и строки, которая на выходе.

У меня считает кол-во слов, а местами не меняет

если будут вопросы, спрашивай

Не работает:

@-что означает?(dec©)

извини багу нашел, ща правлю

означает ( с )

в моей проге цифры - не есть буквы в словах

Глюк форума - поставь dec и в дужках с
dec( с ) - так только без пробелов.


Глянь еще раз, я изменил на буквы.

вот теперь все ок

Ты еще одно условие забыл:

Работает, но частично!Строка считывается, кол-во слов считается. Но мне нужно, чтобы после вывода на экран кол-ка слов была выведена строка, в которой были бы поменены местами слова из исходной строки. К примеру:

Если слов больше, он меняет 1 со 2, 3 с 4, 5 с 6, и тд.

сНежная, а ты внимательно смотрела? Все работает, как ты описала.
Нажмите для просмотра прикрепленного файла

черт


сНежная я сделал только для английских букв

Работает! Огромное спасибо! Сейчас буду пытаться понять, как это сделано!

const max_words = 128;
type
  TWords = array [1..max_words] of String;

function GetWords(s: String; var w: TWords): Integer;
var
  n, i: Integer;
begin
  n := 0;
  while Length(s) > 0 do begin
    inc(n);
    i := 1;
    while (i <= Length(s)) and (s[i] <> ' ') do inc(i);
    w[n] := Copy(s, 1, pred(i));
    delete(s, 1, i);
  end;
  GetWords := n;
end;

procedure Exchange(var w: TWords; const n: Integer);
var
  i: Integer;
  T: String;
begin
  i := 2;
  while (i <= n) do begin
    T := w[i]; w[i] := w[pred(i)]; w[pred(i)] := T;
    inc(i, 2);
  end;
end;

var
  s: String;
  w: TWords;
  n, i: Integer;

begin
  repeat
    clrscr;
    write('s = '); readln(s);
  until (s[1] <> ' ') and (Pos('  ', s) = 0);

  n := GetWords(s, w);
  Exchange(w, n);
  for i := 1 to n do write(w[i], ' ');
end.

klem4 , я не уверен что автор темы знает функции Copy, Delete, Pos и т.д.

Опять за флейм? А насчет Length ты что, уверен? А насчет While? Мало ли, кто чего не знает? Если ты не знаешь, что такое Thread, давай, Windows+Linux + все остальные многозадачные ОСи отменим? Ты ведь этого не знаешь, это же ужасно, как в MS ТЕБЯ не спросили, знаком ли ты с этим понятием, или не очень?