DenMal_5

Function GetWord(Var I: Integer; S: String): String;
Var
    IC, SI: Integer;
Begin
    If S[I] = Chr(0) Then Begin
      GetWord:= ''; Exit;
    End;
    While S[I] = ' ' Do Inc(I); {Пропускаем пробелы}
    IC:= 0;
    While S[I] In ['A'..'Z', 'a'..'z', 'а'..'я', 'А'..'Я'] Do Begin
      If IC = 0 Then SI:= I; {Если первая итерация - начало будет тут}
      Inc(IC);
      Inc(I);
    End;
    GetWord:= Copy(S, SI, I - SI);
End;

{Обработчик, который ты используешь}
Var
    Tex, W: String;
    I: Integer;
Begin
    Tex:= Edit1.Text + Chr(0);
    I:= 1;
    Repeat
      W:= GetWord(I, Tex);
      If W[1] = '' Then Break;
      If UpCase(W[1]) In ['A','E','O','U','I','Y','А','О','У','Э','И','Е','Ё','Ю','Я','Ы'] Then Begin
        WriteLn(W);
      End;
    Until W = '';
End.