Функция для подсчёта гласных [Delphi]

[gabach]

Не могу понять почему функция не хочет считать гласные

//Функция для подсчёта гласных букв
Function KolGlas(const Slovo:ShortString):byte;
var i:byte;
    Glas:set of Char;
begin
result:=0;
Glas:=['А','Е','Ё','И','О','У','Ы','Э','Ю','Я'];
for i:=1 to Length(Slovo) do
if Upcase(Slovo[i]) in Glas then result:=result+1
end;

[newerow1989]

Все дело в функции Upcase! Будет считать ТОЛЬКО английские гласные. Функция Upcase (описана в System.pas) работает только с английскими буквами. Даю код как работает эта функция (взято из этого модуля):

function        UpCase( ch : Char ) : Char;
{$IFDEF PUREPASCAL}
begin
  Result := ch;
  case Result of
    'a'..'z':  Dec(Result, Ord('a') - Ord('A'));//ЗДЕСЬ основная причина!
  end;
end;
{$ELSE}
asm
{ ->    AL      Character       }
{ <-    AL      Result          }

        CMP     AL,'a'
        JB      @@exit
        CMP     AL,'z'
        JA      @@exit
        SUB     AL,'a' - 'A'
@@exit:
end;
{$ENDIF}

Если хотите, чтобы работала с русскими буквами, необходимо перепрограммировать эту функцию.

[Utkin]

Да можно и не лезть так глубоко. В Glas добавить маленькие буковы, а UPCase выкинуть нах.

[Serge_Bliznykov]

Utkin, +1

всё же очень просто:

//Функция для подсчёта гласных букв
Function KolGlas(const Slovo:ShortString):byte;
var 
  i:byte;
begin
  result:=0;
  for i:=1 to Length(Slovo) do
    if Slovo[i] in ['А','Е','Ё','И','О','У','Ы','Э','Ю','Я',
                      'а','е','ё','и','о','у','ы','э','ю','я'] 
       then Inc(result)
end;

[Stilet]

Да. Или если уж хочется и компиль поддерживает использовать AnsiUpperCase().

[WinCoder]

Тогда уж WideUpperCase

[gabach]

спасибо большое, теперь буду внимательнее относится к функциям))

[gabach]

Всё исправил, отдельные слова считает правильно, но я не понимаю почему я тогда не могу отсортировать массив слов

//Функция для подсчёта гласных букв
Function KolGlas(const Slovo:ShortString):byte;
var
  i:byte;
begin
  result:=0;
  for i:=1 to Length(Slovo) do
    if Slovo[i] in ['А','Е','Ё','И','О','У','Ы','Э','Ю','Я',
                    'а','е','ё','и','о','у','ы','э','ю','я']
  then result:=result+1;
end;

 //Сортировка массива и вывод наименьшего(Процедура)
procedure Sort(MSlov1:MShStr; const n:byte);
Var i,imin,j,k,kmin,per:byte;
    slovo1:ShortString;
Begin
//Сортировка методом наименьшего
per:=0;
For i:=1 to n-1 do
  begin
  kmin:=KolGlas(MSlov1[i]);
  imin:=i;
  For j:=i+1 to n do
      begin
      k:=KolGlas(MSlov1[j]);
      if k<kmin then
        begin
        kmin:=k;imin:=j
        end;
      end;
  if imin<>i then
        begin
        slovo1:=MSlov1[i];
        MSlov1[i]:=MSlov1[imin];
        MSlov1[imin]:=slovo1;
        per:=per+1;
        end;
  end;
//Вывод
if (k=0) and (per=0) then
writeln(rus('Слов с гласными нет'))
else
  begin
    Writeln(rus('Отсортированый массив:'));
    For i:=1 to n do
    Writeln(MSlov1[i]);
    Writeln;
    Writeln(rus('Слово с наименьшим числом гласных:'));
    Writeln(MSlov1[1]);
  end;
end;

[Serge_Bliznykov]

gabach, это несерьёзно.

procedure Sort(MSlov1:MShStr; const n:byte);

где описание типа MShStr ?!

Да и выложите код целиком. Где и как Вы вызываете Sort?

[gabach]

Program Stroki;
{$APPTYPE CONSOLE}

uses
  SysUtils;
//Функция для чтения кириллицы
function Rus(S:String) :String;
var i:byte;
begin
  Result:='';
  For i:=1 to Length(S) do
    case S[i] of
 'А'..'п': Result:=Result+Chr(Ord(S[i])-64);
 'р'..'я': Result:=Result+Chr(Ord(S[i])-16);
 'Ё': Result:=Result+Chr(240);
 'ё': Result:=Result+Chr(241);
  else
    Result:=Result+S[i];
  end;
end;

Type MShStr=array[1..100] of ShortString;
var st:ShortString;
    n:byte;
    MSlov:MShStr;

//Ввод и вывод(Процедура)
procedure VvodVivod(var Str:ShortString);
begin
writeln(rus('Введите строку:')); readln(str);
writeln;
writeln(rus('Введёная строка:'));writeln(str);
writeln;
end;

//удаление лишних пробелов(Процедура)
procedure DelProb(var Str:ShortString);
begin
if str[Length(str)]<>' ' then
str:=str+' ';
while pos('  ',str)<>0 do
  begin
    delete(str,pos('  ',str),1);
  end;
if str[1]=' ' then delete(str,1,1);//удалить пробел в начале строки
writeln(rus('Результат:'));
if length(str)<>0 then writeln(str)
else writeln(rus('Строка содержала только пробелы'));
end;

//Выделение слов и вывод массива слов(Процедура)
procedure VidSlov(Str:ShortString; var n:byte; out MSlov1:MShStr);
var i:byte;
begin
n:=0;
while pos(' ',str)>0 do
  begin
    n:=n+1;
    MSlov1[n]:=copy(str,1,pos(' ',str)-1);
    delete(str,1,pos(' ',str));
  end;
writeln;
if n<>0 then begin
Writeln(rus('Массив слов:'));
for i:=1 to n do
writeln(MSlov1[i]);
end;
writeln;
end;

//Функция для подсчёта гласных букв
Function KolGlas(const Slovo:ShortString):byte;
var
  i:byte;
begin
  result:=0;
  for i:=1 to Length(Slovo) do
    if Slovo[i] in ['А','Е','Ё','И','О','У','Ы','Э','Ю','Я',
                    'а','е','ё','и','о','у','ы','э','ю','я']
  then result:=result+1;
end;

 //Сортировка массива и вывод наименьшего(Процедура)
procedure Sort(MSlov1:MShStr; const n:byte);
Var i,imin,j,k,kmin,per:byte;
    slovo1:ShortString;
Begin
//Сортировка методом наименьшего
per:=0;
For i:=1 to n-1 do
  begin
  kmin:=KolGlas(MSlov1[i]);
  imin:=i;
  For j:=i+1 to n do
      begin
      k:=KolGlas(MSlov1[j]);
      if k<kmin then
        begin
        kmin:=k;imin:=j
        end;
      end;
  if imin<>i then
        begin
        slovo1:=MSlov1[i];
        MSlov1[i]:=MSlov1[imin];
        MSlov1[imin]:=slovo1;
        per:=per+1;
        end;
  end;
//Вывод
if (k=0) and (per=0) then
writeln(rus('Слов с гласными нет'))
else
  begin
    Writeln(rus('Отсортированый массив:'));
    For i:=1 to n do
    Writeln(MSlov1[i]);
    Writeln;
    Writeln(rus('Слово с наименьшим числом гласных:'));
    Writeln(MSlov1[1]);
  end;
end;

//Основная программа
begin
VvodVivod(St);
DelProb(St);
VidSlov(St,n,MSlov);
Sort(MSlov,n);
readln;
end.