çok önceden delphi ile yaptığım bir heceleme algoritması. uzun zaman sonra görünce buraya da yazmak istedim.
programın algoritmasını yazarken nasıl hecelediğimizi keşfetmiştim o nedenle severim bu algoritmayı.
ayrıca bu ve benzeri kodları yayınlarken kodları renklendirebileceğim bi wp plugini bilen var mı?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ALScrollingText;
type
TForm1 = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
function sesli(harf:string):boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function tform1.sesli(harf:string):boolean;
begin
result:=false;
if harf='a'then result:=true;
if harf='e'then result:=true;
if harf='ı'then result:=true;
if harf='i'then result:=true;
if harf='o'then result:=true;
if harf='ö'then result:=true;
if harf='u'then result:=true;
if harf='ü'then result:=true;
if harf='A'then result:=true;
if harf='E'then result:=true;
if harf='I'then result:=true;
if harf='İ'then result:=true;
if harf='O'then result:=true;
if harf='Ö'then result:=true;
if harf='U'then result:=true;
if harf='Ü'then result:=true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
Memo2.Text := EmptyStr;
for i := 1 to length(Memo1.Text) do
begin
if
not sesli(copy(Memo1.Text,i,1))
and sesli(copy(Memo1.Text,i+1,1))
and not (copy(Memo1.Text,i,1)=' ')
and not (copy(Memo1.Text,i-1,1)=' ')
and not (copy(Memo1.Text,i+1,1)=' ')
then
begin
Memo2.text := Memo2.text+'-';
end;
if sesli(copy(memo1.Text,i,1))
and sesli(copy(memo1.Text,i-1,1))
then
begin
Memo2.text := Memo2.text+'-';
end;
Memo2.Text := Memo2.Text + copy(Memo1.Text,i,1);
end;
if copy(Memo2.Text,1,1) = '-' then
begin
Memo2.Text := copy(Memo2.Text,2,length(Memo2.text)-1);
end;
end;
end.
