Упорядочение слов по алфавиту, Обработка текстовых строк Опции

[FENIX]

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

Сделал все, кроме печати регулярных цепочек в алфавитном порядке.
Подскажите, как это сделать.

З.Ы. Регулярная цепочка - слово, состоящее только больших английских букв.

:low:

Код

Program Lab;
Uses Crt;

type letters = set of 'A'..'Z';


const  gl : letters = ['E', 'Y', 'U', 'I', 'O', 'A'];
      sogl : letters = (['A'..'Z'] - ['E', 'Y', 'U', 'I', 'O', 'A']);
      alphabet = ['A'..'Z', 'a'..'z'];
      digits = ['0'..'9'];


var  maxslovo, st, slovo, s : string;
    ch : char;
    i, n, k, j, dlina, max : integer;

Function length1(s : string) : integer;
begin
  length1 := ord(s[0]);
end;

Function RegCep (s : string) : boolean;
var i : integer;
begin
  RegCep := true;
  For i := 1 to length(s) do
  if (ord(s[i]) < 65) or (ord(s[i]) > 90) then RegCep := false;
end;

Function Cheredovanie (s : string) : boolean;
var i : integer;
b1, b2 : boolean;
begin
  cheredovanie := true;
  if s[1] in gl then
     For i := 1 to length(s) do
       if i mod 2 = 1 then
          if not(s[i] in gl) then cheredovanie := false else else
             if not(s[i] in sogl) then cheredovanie := false;

  if s[1] in sogl then
     For i := 1 to length(s) do
       if i mod 2 = 1 then
          if not(s[i] in sogl) then cheredovanie := false else else
             if not(s[i] in gl) then cheredovanie := false;
end;

Function  BykvbI(s : string): boolean;
var i : integer;
begin
BykvbI := false;
For i := 1 to length(s) do
If s[i] in alphabet then BykvbI := true;
end;

Function  CbIfrbI(s : string): boolean;
var i : integer;
begin
CbIfrbI := false;
For i := 1 to length(s) do
If s[i] in digits then CbIfrbI := true;
end;


Procedure Perevorot (var s : string);
var buf : char;
     i : integer;
begin
  For i := 1 to length(s) div 2 do
  begin
       buf := s[i];
       s[i] := s[length(s) - i + 1];
       s[length(s) - i + 1] := buf;
  end;
  writeln('Camoe dlinnoe slovo - ',s);
end;

BEGIN
ClrScr;
max := 0;
Write('Vvedite stroky simvolov : ');
Readln(st);
st := st + ' ';
slovo := '';
dlina := 0;

For i := 1 to length(st) do
     if st[i] <> ' ' then slovo := slovo + st[i]
        else if length(slovo) <> 0 then
        begin
              If RegCep(slovo) and Cheredovanie(slovo) then
              begin
                 dlina := dlina + length(slovo);
              end;
        If length(slovo) > max then
        begin
           max := length(slovo);
           maxslovo := slovo;
        end;
        slovo := '';
end;
writeln;
writeln('Dlina = ', dlina);
writeln;
If (BykvbI(maxslovo) = true) and (CbIfrbI(maxslovo) = true) then
Perevorot(maxslovo)
else writeln('Takogo slova net :-(');
readln;
END.

[volvo]

FENIX
Посмотри, я подправил кое-что (Cheredovanie) и добавил то, что было нужно...

Program Lab;
Uses Crt;

type letters = set of 'A'..'Z';


const
  gl = ['E', 'Y', 'U', 'I', 'O', 'A'];
  sogl = (['A'..'Z'] - gl{['E', 'Y', 'U', 'I', 'O', 'A']});
  alphabet = ['A'..'Z', 'a'..'z'];
  digits = ['0'..'9'];

const
  sets: array[boolean] of letters = (gl, sogl);


var
  words: array[1 .. 50] of string;
  word_count: integer;
  T: string;

  maxslovo, st, slovo, s : string;
  ch : char;
  i, n, k, j, dlina, max : integer;

Function length1(s : string) : integer;
  begin
    length1 := ord(s[0]);
  end;

Function RegCep (s : string) : boolean;
  var i : integer;
  begin
    RegCep := true;
    For i := 1 to length(s) do
      if (ord(s[i]) < 65) or (ord(s[i]) > 90) then RegCep := false;
  end;

Function Cheredovanie (s : string) : boolean;
  var
    i : integer;
    is_glas, res: boolean;
  begin
    res := true;
    is_glas := (s[1] in gl);
    for i := 1 to length(s) do
      if odd(i) then
        res := res and (not (s[i] in sets[is_glas]))
      else
        res := res and (not (s[i] in sets[not is_glas]));
    cheredovanie := res
  end;

Function  BykvbI(s : string): boolean;
  var i : integer;
  begin
    BykvbI := false;
    For i := 1 to length(s) do
      If s[i] in alphabet then BykvbI := true;
  end;

Function  CbIfrbI(s : string): boolean;
  var i : integer;
  begin
    CbIfrbI := false;
    For i := 1 to length(s) do
      If s[i] in digits then CbIfrbI := true;
  end;


Procedure Perevorot (var s : string);
  var buf : char;
  i : integer;
  begin
    For i := 1 to length(s) div 2 do
      begin
        buf := s[i];
        s[i] := s[length(s) - i + 1];
        s[length(s) - i + 1] := buf;
      end;
    writeln('Camoe dlinnoe slovo - ',s);
  end;

BEGIN
  ClrScr;
  max := 0;
  Write('Vvedite stroky simvolov : ');
  Readln(st);

  st := st + ' ';
  slovo := '';
  dlina := 0; word_count := 0;

  For i := 1 to length(st) do
    if st[i] <> ' ' then slovo := slovo + st[i]
    else if length(slovo) <> 0 then
      begin
        If RegCep(slovo) and Cheredovanie(slovo) then
          begin
            dlina := dlina + length(slovo);
            inc(word_count); words[word_count] := slovo;
          end;
        If length(slovo) > max then
          begin
            max := length(slovo);
            maxslovo := slovo;
          end;
        slovo := '';
      end;
    writeln;
    writeln('Dlina = ', dlina);
    writeln;

    For i := 1 To word_count Do
       For j := word_count DownTo i+1 Do
         If words[j - 1] > words[j] Then
           Begin
             T := words[j - 1]; words[j - 1] := words[j]; words[j] := T
           End;

    writeln('words in ABC order:');
    for i := 1 to word_count do
      write(words[i], ' ');
    writeln;

    If (BykvbI(maxslovo) = true) and (CbIfrbI(maxslovo) = true) then
      Perevorot(maxslovo)
    else writeln('Takogo slova net :-(');
    readln;
END.