delphi. функции, процедуры
Помогите,пожалуйста дописать программу.
Вот условие :Дана строка, содержащая русский текст.
Если в тексте есть слово, в котоpом есть две одинаковые гласные буквы,
то удалить из слов текста согласные,
в противном случае пpодублиpовать в словах,
содеpжащих не менее 2-х гласных, гласные буквы.
Полученные слова вывести в алфавитном поpядке
Код:
uses SysUtils;
const wordmax = 10000;
type MasSlov = array[1..wordmax] of string;
var
T : string;
Tmas : MasSlov;
j, i, n : Integer;
p : Boolean;
Letters : Set Of Char = ['А'..'я'];
Sogl : Set Of Char = ['Й','й','Ц','ц','К','к','Н',
'н','Г','г','Ш','ш','Щ','щ','З','з','Х','х','Ъ','ъ','Ф','ф',
'В','в','П','п','Р','р','Л','л','Д','д','Ж','ж','Ч','ч',
'С','с','М','м','Т','т','Ь','ь','Б','б'];
Glas : Set Of Char = ['а', 'А', 'Я', 'я', 'Е', 'е', 'Ё', 'ё',
'у', 'У', 'о', 'О', 'И', 'и', 'Ы', 'ы', 'Э', 'э', 'ю', 'Ю'];
{Распаковка текста}
Procedure Unpack(var Tmas : MasSlov; var n : integer);
var j : Integer;
s,w : string;
begin
reset(input,'input.txt');
readln(s);
s:=s+' ';
w:='';
n:=0;
for j:=1 to Length(s) Do
if s[j] in Letters then w:=w+s[j]
else if w<>'' then begin
inc(n);
Tmas[n]:=w;
w:='';
end;
end;
function proverka(s:string):boolean;
var i : integer;
mn: Set of char;
begin
proverka:=false;
mn:=[];
for i:=1 to length(s) do
if (s[i] in Glas) then
if s[i] in mn then begin
proverka:=true;
exit;
end
else mn:=mn+s[i];
end;
function proverka1(Tmas: MasSlov;n : ineger):boolean;
var i : integer
begin
proverka1:=false;
for i:=1 to n do
if proverka(Tmas[i]) then begin
proverka1:=true;
exit;
end;
end;
procedure del(var Tmas: );
var i,j: integer;
s : string;
begin
for i:=1 to n do begin
s:='';
for j:=1 to length(Tmas[i]) do
if Tmas[i][j] in Glas then s:=s+Tmas[i][j];
if s<>'' then Tmas[i]:=s;
end;
{Количество гласных}
function KolGlas(s:string):integer;
var i,j:integer;
begin
j:=0;
for i := 1 to length(s) do
if (s[i] in Glas) then inc(j);
KolGlas:=j;
end;
|