Gelişmiş türkçe sözcük heceleme

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
csyasar
Üye
Mesajlar: 646
Kayıt: 25 Şub 2004 10:14
Konum: Tokat

Gelişmiş türkçe sözcük heceleme

Mesaj gönderen csyasar »

function Sesli(Harf: Char): Boolean;
begin
Result := Pos(Harf, 'aeıioöuüAEIİOÖUÜ') > 0;
end;

function Sessiz(Harf: Char): Boolean;
begin
Result := Pos(Harf, 'bcçdfgğhjklmnpqrsştvyxwzBCÇDFGĞHJKLMNPQRSŞTVYXWZ') > 0;
end;

function Harf(Harf: Char): Boolean;
begin
Result := Sesli(Harf) or Sessiz(Harf);
end;

function Ayirac(Harf: Char): Boolean;
begin
Result := Pos(Harf, '''")]}') > 0;
end;

function Hecele(mesaj: String): String;
var
g : string;
i : integer;
begin
g := '';
i := Length(mesaj);
while i>0 do
begin
// Uzun metinler icin konulabilir..
Application.ProcessMessages;
//
g := mesaj + g;
if Sesli(mesaj) then
begin
if Sesli(mesaj[i-1]) then
g := '-' + g;
if Sessiz(mesaj[i-1]) and Harf(mesaj[i-2]) then
begin
g := '-' + mesaj[i-1] + g;
i := i - 1;
end;
// Ayıraclar gözardi edilebilir..
if Ayirac(mesaj[i-1]) and Harf(mesaj[i-2]) then
g := '-' + g;
if Ayirac(mesaj[i-2]) and Harf(mesaj[i-3]) then
begin
g := '-' + mesaj[i-1] + g;
i := i - 1;
end;
// ayiraclar
end;
i := i - 1;
end; // while sonu
Result := g;
end;

// Kullanimi

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo2.Text := Hecele(Memo1.Text);
end;
Cevapla