ФИО, работа со строками

[Poma][a]

Задали на писать программку, которая при вводе фамилии, имени, и отчества, выведет фамилию, пробел, первую букву имени, точку и первую букву отчества, точку.Но между ФИО есть до хрена пробелов.
програмку я на писал она рабочая :

program FIO;

var 
             s : string;
             i, k, j : Integer;

begin
             ReadLn (s);
             i :=  Pos ('  ', s);
             while i <> 0 do begin
                         j := 1 + 2;
                         while s [j] = '  ' do
                                         Inc (j);
                         Delete (s, i, j- i -1);
                         i := Pos ('  ', s);
            end;
            i := Pos (' ', s);
            Delete (s, i, 1);
            j := Pos (s, j, 1);
            Delete (s, j, 1);
            Delete (s, j + 1; Length (s));
            Insert ('.', s, j + 1);
            Delete (s, i + 1, j - i -1);
            Insert ('.',  s, i + 1);
            Insert (' ', s, i);
            WriteLn (s)
end.

вот НО сначала я удаляю пробел

  
            i := Pos (' ', s);
            Delete (s, i, 1);

а потом его всталяю

  
            Insert (' ', s, i);

Помогите избежать этого

[JUDAS]

program FIO;

 function Trim(const S: string): string;
 var  I ,L : Integer;
 begin
   L := Length(S);
   I := 1;
   while (I <= L) and (S[I] <= ' ') do Inc(I);
   if I > L then Result := '' else
   begin
     while S[L] <= ' ' do Dec(L);
     Result := Copy(S, I, L - I + 1);
   end;
 end;

var 
  f,i,o: string;
begin
  writeln('familia ');readln(f);
  writeln('mane ');readln(i);
  writeln('bigname ');readln(o);

  i:=i+' '; o:=o+' ';
  f:=trim(f)+' '+i[1]+'.'+o[1]+'.';
  writeln(f);
end.

[Poma][a]

Сообщение от JUDAS

program FIO;

 function Trim(const S: string): string;
 var  I ,L : Integer;
 begin
   L := Length(S);
   I := 1;
   while (I <= L) and (S[I] <= ' ') do Inc(I);
   if I > L then Result := '' else
   begin
     while S[L] <= ' ' do Dec(L);
     Result := Copy(S, I, L - I + 1);
   end;
 end;

var 
  f,i,o: string;
begin
  writeln('familia ');readln(f);
  writeln('mane ');readln(i);
  writeln('bigname ');readln(o);

  i:=i+' '; o:=o+' ';
  f:=trim(f)+' '+i[1]+'.'+o[1]+'.';
  writeln(f);
end.

спасибо, НО мне нужно ИМЕННО эту( МОЮ) программу только без удаления первого пробела ПОМОГИТЕ

[JUDAS]

мне нужно ИМЕННО эту программу

Извините, но мне лучше написать свой код чем переписать чужую кашу.
--------
Давайте попробуем проанализировать:

 
 ReadLn (s); // ввод строки
 i :=  Pos ('  ', s); // ищем первый пробел
 while i <> 0 do   // если побел есть (в независимости от возможного ввод двойной фамилии типо Панкратов Чёрный, Ван Гог и.т.п Ваш цикл начинает маслать)
 begin
    j := 1 + 2; // j=3 всегда
    while s [j] = '  ' do Inc (j); // пока символ пробел (с 3-го по беконечность ) идёт счёт  ВОПРОС: тут не зацыкливается прога и не вылетает если J> длины ???
   Delete (s, i, j- i -1); // удалчем с И-го символа 3 или больше симолов (включая двойную фамилию)
   i := Pos ('  ', s); // ищем очередной символ "пробел"
 end;
// первая часть кода очень заманичива (((
 // не смотря на то что все пробелы удаляются вверху ищем пробел ещё раз 
  i := Pos (' ', s);
  Delete (s, i, 1); // в независимости i=0 или <>0 удаляем 1 символ (не вылетает если не пробелов)?
  j := Pos (s, j, 1); // тут я вообще не понял синтаксис 
  Delete (s, j, 1);   // и что удаляется
  
  Delete (s, j + 1; Length (s));  // непонятній синаксис
  Insert ('.', s, j + 1); // вставка 
  Delete (s, i + 1, j - i -1);
  Insert ('.',  s, i + 1);
  Insert (' ', s, i);
  WriteLn (s)
end.

и.т.п

[JUDAS]

program Project1;
var
  fio,R : string;
  p,i   : integer;
begin
  writeln('familia name otchestvo ');readln(fio);
  // удаляем двойные пробелы
  while Pos('  ', fio)>0 do
  delete(fio, Pos('  ', fio),1);
  // удаляем пробелы вначале
  while (fio<>'') and (fio[1]=' ') do
  delete(fio, 1, 1);
  // удаляем пробелы в конце
  while (fio<>'') and (fio[length(fio)]=' ') do
  setlength(fio, LenGth(fio)-1);
  p:=0;
  for i:=LenGth(fio) downto 1 do
  if (p<2) and (fio[i]=' ') then
  begin
   R:=fio[i+1]+'.'+R;
   inc(p);
   if p=2 then
   begin
    R:=Copy(fio,1,i-1)+' '+R;
    break;
   end;
  end;
  writeln(R);
end.

Предлагаю вариант 2 вводится одной строкой Ф.И.О (включая двойные и тройные фамилии) делает что надо

[Poma][a]

Сообщение от JUDAS

Извините, но мне лучше написать свой код чем переписать чужую кашу.
--------
Давайте попробуем проанализировать:

 
 ReadLn (s); // ввод строки
 i :=  Pos ('  ', s); // ищем первый пробел
 while i <> 0 do   // если побел есть (в независимости от возможного ввод двойной фамилии типо Панкратов Чёрный, Ван Гог и.т.п Ваш цикл начинает маслать)
 begin
    j := 1 + 2; // j=3 всегда
    while s [j] = '  ' do Inc (j); // пока символ пробел (с 3-го по беконечность ) идёт счёт  ВОПРОС: тут не зацыкливается прога и не вылетает если J> длины ???
   Delete (s, i, j- i -1); // удалчем с И-го символа 3 или больше симолов (включая двойную фамилию)
   i := Pos ('  ', s); // ищем очередной символ "пробел"
 end;
// первая часть кода очень заманичива (((
 // не смотря на то что все пробелы удаляются вверху ищем пробел ещё раз 
  i := Pos (' ', s);
  Delete (s, i, 1); // в независимости i=0 или <>0 удаляем 1 символ (не вылетает если не пробелов)?
  j := Pos (s, j, 1); // тут я вообще не понял синтаксис 
  Delete (s, j, 1);   // и что удаляется
  
  Delete (s, j + 1; Length (s));  // непонятній синаксис
  Insert ('.', s, j + 1); // вставка 
  Delete (s, i + 1, j - i -1);
  Insert ('.',  s, i + 1);
  Insert (' ', s, i);
  WriteLn (s)
end.

и.т.п

)) в цикле о удаляет НЕ 1 пробел, а 2 в, а дальше остаётся 2 пробела : один между фамилией и именем, другой между имене и отчеством, цикл на ходит 1 и удаляет его, находит 2 и удаляет все пробелы от найденолй позиции, до конца строки, затем вставляет туда '.' , а после вспоминаем позицию 1 пробела, и удаляем от этой позиции, до первой буквы отчества, вставляем туда точку И самое гласное вставляем пробел между именем и фамилией, и мне нужно избежать сначал удаления потом вставки пробела

[Poma][a]

и кстати можно использовать только 1 строку)

[Poma][a]

помоги мне завтра уже здавать...

[JUDAS]

http://www.programmersforum.ru/showp...77&postcount=5 пост 5 попробуйте.

[Poma][a]

Сообщение от JUDAS

http://www.programmersforum.ru/showp...77&postcount=5 пост 5 попробуйте.

ТОЛЬКО 1 строка