ses hecelemek

[lodos]

slm arkadaslar ben bi program geliştircem ama sizden bir yardım almak istiyorum
forumda arama yaptım ama bulamadım varsa özr dilerim
programda yazlılan bir seyi heceletcem yanı a ise a.mp3 ab a.mp3+b.mp3 gibi

if else olayını nasıl kullanabilirim burda

bide

SetKey, GotoKey, GotoNearest, Locate hangisini kulanıcagımı biilmiyorum en iyisi sizce hangisi ??

şimdiden tesekurler

[mrmarman]

Forumdan Ref : @csyasar veya
Programlama.Com sitesinden Ref: @Yusuf GAMSIZ tarafından yayınlanan heceleme fonksiyonu vardı. Seçeceğin biriyle başlayabilirsin.

Kod: Tümünü seç

function Hecele(Sozcuk : String) : String;
var
  hn : Integer;
  hc : Boolean;
  function Sesli(Harf : Char) : Boolean;
  begin
    Result := Harf in ['a', 'A', 'e', 'E', 'ı', 'I', 'i', 'İ', 'o', 'O', 'ö', 'Ö', 'u', 'U', 'ü', 'Ü'];
  end;
begin
  Result := '';
  hn     := Length(Sozcuk);
  hc     := False;
  while hn > 0 do begin
    Result := Sozcuk[hn] + Result;
    if Sesli(Sozcuk[hn]) then
      if hc then hc := (hn = 1) or not Sesli(Sozcuk[hn - 1])
            else hc := true
    else if hc then hc := not Sesli(Sozcuk[hn + 1])
               else hc := true;
    if not hc and (hn > 1) then Result := '-' + Result;
    hn := hn - 1;
  end; // While
end;

- Bulduğun her hecenin sonuna .MP3 koyarsın ve dinletirsin.

- Veritabanında arama üzerine sorunun bu konuyla ilişkisi var mı bilmiyorum ama Index aramalar her zaman en hızlısıdır. Diğer yandan Veritabanı küçük ise hız norma bir bilgisayarda bu hız farkının algılanabileceğini sanmıyorum.

[lodos]

yanı Locate diyorsun

sag ol bunlar için tesekkurler

[baypipox]

okuldayken yazıyı sese çeviren program benim projemdi dandirik bişey ama bir bak fikrin olur fonemler hakkında






unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, mmsystem;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
type a=set of char;
var kel:string;
bir,iki,m:string;
fonem:array[1..1000] of string;
hec:array[1..100] of string;
say:integer;
uz,j,k,i,ko:integer;
birb,ikib:boolean;
un:a;
begin
memo1.Clear;
ko:=length(edit1.text);
m:=' ';
for i:=1 to ko do begin
if copy(edit1.Text,i,1)<> m
then kel:=kel+copy(edit1.Text,i,1);
end;
say:=1;
un:=['a','e','ı','i','o','ö','u','ü','A','E','I','İ','O','Ö','U','Ü'];

repeat
uz:=length(kel);
if uz>=2 then begin


if kel[1] in un then begin

birb:=true;end
else begin
birb:=false;end;
if kel[2] in un then begin
ikib:=true;end
else begin
ikib:=false;end;
if (birb=true) and (ikib=false) then begin
hec[say]:=copy(kel,1,1);
say:=say+1;
hec[say]:=copy(kel,1,2);
say:=say+1;
delete(kel,1,2);uz:=length(kel);end
else if (birb=false) and (ikib=true) then begin

hec[say]:=copy(kel,1,2);
say:=say+1;
delete(kel,1,1);uz:=length(kel);
end
else if (birb=true) and (ikib=true) then begin

hec[say]:=copy(kel,1,1);
say:=say+1;
delete(kel,1,1);uz:=length(kel);
end;
end;
if uz<2 then begin
hec[say]:=copy(kel,1,1);
delete(kel,1,1);
uz:=length(kel);
end;
until uz<1;
for j:=1 to say do begin
memo1.Lines.Add(hec[j]);
end;

for i:=0 to memo1.lines.count do fonem:='c:\proje\sesler\'+memo1.lines+'.wav';
for i:=0 to memo1.lines.count do
PlaySound(pchar(fonem), 0, SND_FILENAME + SND_SYNC);


end;

end

[baypipox]

bunu ben yapmadım buda hocamın yaptığı onunki misal "türk" kelimesi gibi iki sessiz harfi okuyabiliyodu...



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,mxarrays,MMSystem;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Edit2: TEdit;
Edit3: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);


private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
M,SS:string;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
type
tsesliler=set of char;
var
sesliler:tsesliler;
i,k:integer;
kontrol,F:string;
fonem:array[1..600] of string;
begin
sesliler:=['A','E','I','İ','O','Ö','U','Ü','a','e','ı','i','o','ö','u','ü'];
M:=edit1.text;
edit2.text:='n';
for i:=1 to edit1.gettextlen do
if m=' ' then edit2.text:=edit2.text+'n'
else if m in sesliler then edit2.text:=edit2.text+'a' else edit2.text:=edit2.text+'b';
edit2.text:=edit2.text+'n';
SS:=edit2.text;

SS:=edit2.text;
for k:=1 to edit1.gettextlen do
begin
kontrol:=SS[k]+SS[k+1]+SS[k+2];
if kontrol='nbb' then
begin
if M[k+2] in ['a','ı'] then edit1.text:=copy(M,1,k)+'ı'+copy(M,k+1,edit1.gettextlen);
if M[k+2] in ['e','i'] then edit1.text:=copy(M,1,k)+'i'+copy(M,k+1,edit1.gettextlen);
if M[k+2] in ['o'] then edit1.text:=copy(M,1,k)+'o'+copy(M,k+1,edit1.gettextlen);
if M[k+2] in ['ö'] then edit1.text:=copy(M,1,k)+'ö'+copy(M,k+1,edit1.gettextlen);
if M[k+2] in ['u'] then edit1.text:=copy(M,1,k)+'u'+copy(M,k+1,edit1.gettextlen);
if M[k+2] in ['ü'] then edit1.text:=copy(M,1,k)+'ü'+copy(M,k+1,edit1.gettextlen);
end;
end;

sesliler:=['A','E','I','İ','O','Ö','U','Ü','a','e','ı','i','o','ö','u','ü'];
M:=edit1.text;
edit2.text:='n';
for i:=1 to edit1.gettextlen do
if m=' ' then edit2.text:=edit2.text+'n'
else if m in sesliler then edit2.text:=edit2.text+'a' else edit2.text:=edit2.text+'b';
edit2.text:=edit2.text+'n';
SS:=edit2.text;



{HECELERE AYIRMA İŞLEMİ}
i:=0;
edit3.text:=' ';

{Tek Harf}
repeat i:=i+1;

kontrol:=SS+SS[i+1]+SS[i+2];
if kontrol='nan' then edit3.text:=edit3.text+M+' ';
if (kontrol='ban')then edit3.text:=edit3.text+M[i-1]+M+' ';
{iki harf}
kontrol:=SS+SS[i+1]+SS[i+2]+SS[i+3];
if (kontrol='nabn') then edit3.text:=edit3.text+M+M[i+1]+' ';
if (kontrol='babn') or (kontrol='baan') or (kontrol='aabn')or (kontrol='abbn')then edit3.text:=edit3.text+M[i-1]+M+M[i+1]+' ';
{üç harf}
kontrol:=SS[i]+SS[i+1]+SS[i+2]+SS[i+3]+SS[i+4];
if (kontrol='nabbn') then edit3.text:=edit3.text+M[i]+M[i+1]+M[i+2]+' ';
if (kontrol='naabn') or (kontrol='naban') then edit3.text:=edit3.text+M[i]+' ';



{dörtten fazla}

kontrol:=SS[i]+SS[i+1]+SS[i+2]+SS[i+3];
if (kontrol='baba') then
begin edit3.text:=edit3.text+M[i-1]+M[i]+' '; i:=i+1; end
else if (kontrol='baab') then
begin edit3.text:=edit3.text+M[i-1]+M[i]+' ';i:=i+1; end
else if (kontrol='abba') then
begin edit3.text:=edit3.text+M[i-1]+M[i]+' ';i:=i+1; end
else if (kontrol='abab') then edit3.text:=edit3.text+M[i-1]+' '
else if (kontrol='babb') then
begin
{dört harf}
kontrol:=SS[i]+SS[i+1]+SS[i+2]+SS[i+3]+SS[i+4];
if (kontrol='babbn') or (kontrol='babbb')then edit3.text:=edit3.text+M[i-1]+M[i]+' '+M[i]+M[i+1]+' '+M[i]+M[i+2]+' '
else edit3.text:=edit3.text+M[i-1]+M[i]+M[i+1]+' ';i:=i+2;
end;
until i>edit2.gettextlen;


{HECELERE AYIRMA İŞLEMİ SONU}

{FONEMLERE AYIRMA İŞLEMİ}
i:=0;
F:=edit3.text;
sesliler:=['A','E','I','İ','O','Ö','U','Ü','a','e','ı','i','o','ö','u','ü'];
memo1.Clear;
for i:=1 to edit3.gettextlen do
begin
if F[i] in sesliler then
begin
if ((F[i-1]=' ') and (F[i+1]=' ')) then memo1.lines.add(F[i]);
end
else
begin
if F[i]<>' ' then
begin
if F[i-1] in sesliler then memo1.lines.add(F[i-1]+F[i]);
if F[i+1] in sesliler then memo1.lines.add(F[i]+F[i+1]);
end
end

end;
{FONEMLERE AYIRMA İŞLEMİ SONU}
{OKUMA İŞLEMİ}
for i:=0 to memo1.lines.count do fonem[i]:='c:\texttowav\texttowav\'+memo1.lines[i]+'.wav';
for i:=0 to memo1.lines.count do
PlaySound(pchar(fonem[i]), 0, SND_FILENAME + SND_SYNC);
{OKUMA SONU}
end;




end.

[mrmarman]

- Lütfen kodlarınızı CODE tagına alınız. Progamcılık adına okunması kolay olması yani formatlı görüntü için önemlidir...

- Forum kuralları gereğidir ve riayet edilmesi gerekir.

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, mmsystem;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
{ Private declarations }
  public
{ Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
type a = set of char;
var kel: string;
  bir, iki, m: string;
  fonem: array[1..1000] of string;
  hec: array[1..100] of string;
  say: integer;
  uz, j, k, i, ko: integer;
  birb, ikib: boolean;
  un: a;
begin
  memo1.Clear;
  ko := length(edit1.text);
  m := ' ';
  for i := 1 to ko do begin
    if copy(edit1.Text, i, 1) <> m
      then kel := kel + copy(edit1.Text, i, 1);
  end;
  say := 1;
  un := ['a', 'e', 'ı', 'i', 'o', 'ö', 'u', 'ü', 'A', 'E', 'I', 'İ', 'O', 'Ö', 'U', 'Ü'];

  repeat
    uz := length(kel);
    if uz >= 2 then begin


      if kel[1] in un then begin

        birb := true; end
      else begin
        birb := false; end;
      if kel[2] in un then begin
        ikib := true; end
      else begin
        ikib := false; end;
      if (birb = true) and (ikib = false) then begin
        hec[say] := copy(kel, 1, 1);
        say := say + 1;
        hec[say] := copy(kel, 1, 2);
        say := say + 1;
        delete(kel, 1, 2); uz := length(kel); end
      else if (birb = false) and (ikib = true) then begin

        hec[say] := copy(kel, 1, 2);
        say := say + 1;
        delete(kel, 1, 1); uz := length(kel);
      end
      else if (birb = true) and (ikib = true) then begin

        hec[say] := copy(kel, 1, 1);
        say := say + 1;
        delete(kel, 1, 1); uz := length(kel);
      end;
    end;
    if uz < 2 then begin
      hec[say] := copy(kel, 1, 1);
      delete(kel, 1, 1);
      uz := length(kel);
    end;
  until uz < 1;
  for j := 1 to say do begin
    memo1.Lines.Add(hec[j]);
  end;

  for i := 0 to memo1.lines.count do fonem[i] := 'c:\proje\sesler\' + memo1.lines[i] + '.wav';
  for i := 0 to memo1.lines.count do
    PlaySound(pchar(fonem[i]), 0, SND_FILENAME + SND_SYNC);
end;
end

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, mxarrays, MMSystem;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);


  private
{ Private declarations }
  public
{ Public declarations }
  end;

var
  Form1: TForm1;
  M, SS: string;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
type
  tsesliler = set of char;
var
  sesliler: tsesliler;
  i, k: integer;
  kontrol, F: string;
  fonem: array[1..600] of string;
begin
  sesliler := ['A', 'E', 'I', 'İ', 'O', 'Ö', 'U', 'Ü', 'a', 'e', 'ı', 'i', 'o', 'ö', 'u', 'ü'];
  M := edit1.text;
  edit2.text := 'n';
  for i := 1 to edit1.gettextlen do
    if m[i] = ' ' then edit2.text := edit2.text + 'n'
    else if m[i] in sesliler then edit2.text := edit2.text + 'a' else edit2.text := edit2.text + 'b';
  edit2.text := edit2.text + 'n';
  SS := edit2.text;

  SS := edit2.text;
  for k := 1 to edit1.gettextlen do
  begin
    kontrol := SS[k] + SS[k + 1] + SS[k + 2];
    if kontrol = 'nbb' then
    begin
      if M[k + 2] in ['a', 'ı'] then edit1.text := copy(M, 1, k) + 'ı' + copy(M, k + 1, edit1.gettextlen);
      if M[k + 2] in ['e', 'i'] then edit1.text := copy(M, 1, k) + 'i' + copy(M, k + 1, edit1.gettextlen);
      if M[k + 2] in ['o'] then edit1.text := copy(M, 1, k) + 'o' + copy(M, k + 1, edit1.gettextlen);
      if M[k + 2] in ['ö'] then edit1.text := copy(M, 1, k) + 'ö' + copy(M, k + 1, edit1.gettextlen);
      if M[k + 2] in ['u'] then edit1.text := copy(M, 1, k) + 'u' + copy(M, k + 1, edit1.gettextlen);
      if M[k + 2] in ['ü'] then edit1.text := copy(M, 1, k) + 'ü' + copy(M, k + 1, edit1.gettextlen);
    end;
  end;

  sesliler := ['A', 'E', 'I', 'İ', 'O', 'Ö', 'U', 'Ü', 'a', 'e', 'ı', 'i', 'o', 'ö', 'u', 'ü'];
  M := edit1.text;
  edit2.text := 'n';
  for i := 1 to edit1.gettextlen do
    if m[i] = ' ' then edit2.text := edit2.text + 'n'
    else if m[i] in sesliler then edit2.text := edit2.text + 'a' else edit2.text := edit2.text + 'b';
  edit2.text := edit2.text + 'n';
  SS := edit2.text;



{HECELERE AYIRMA İŞLEMİ}
  i := 0;
  edit3.text := ' ';

{Tek Harf}
  repeat i := i + 1;

    kontrol := SS[i] + SS[i + 1] + SS[i + 2];
    if kontrol = 'nan' then edit3.text := edit3.text + M[i] + ' ';
    if (kontrol = 'ban') then edit3.text := edit3.text + M[i - 1] + M[i] + ' ';
{iki harf}
    kontrol := SS[i] + SS[i + 1] + SS[i + 2] + SS[i + 3];
    if (kontrol = 'nabn') then edit3.text := edit3.text + M[i] + M[i + 1] + ' ';
    if (kontrol = 'babn') or (kontrol = 'baan') or (kontrol = 'aabn') or (kontrol = 'abbn') then edit3.text := edit3.text + M[i - 1] + M[i] + M[i + 1] + ' ';
{üç harf}
    kontrol := SS[i] + SS[i + 1] + SS[i + 2] + SS[i + 3] + SS[i + 4];
    if (kontrol = 'nabbn') then edit3.text := edit3.text + M[i] + M[i + 1] + M[i + 2] + ' ';
    if (kontrol = 'naabn') or (kontrol = 'naban') then edit3.text := edit3.text + M[i] + ' ';



{dörtten fazla}

    kontrol := SS[i] + SS[i + 1] + SS[i + 2] + SS[i + 3];
    if (kontrol = 'baba') then
    begin edit3.text := edit3.text + M[i - 1] + M[i] + ' '; i := i + 1; end
    else if (kontrol = 'baab') then
    begin edit3.text := edit3.text + M[i - 1] + M[i] + ' '; i := i + 1; end
    else if (kontrol = 'abba') then
    begin edit3.text := edit3.text + M[i - 1] + M[i] + ' '; i := i + 1; end
    else if (kontrol = 'abab') then edit3.text := edit3.text + M[i - 1] + ' '
    else if (kontrol = 'babb') then
    begin
{dört harf}
      kontrol := SS[i] + SS[i + 1] + SS[i + 2] + SS[i + 3] + SS[i + 4];
      if (kontrol = 'babbn') or (kontrol = 'babbb') then edit3.text := edit3.text + M[i - 1] + M[i] + ' ' + M[i] + M[i + 1] + ' ' + M[i] + M[i + 2] + ' '
      else edit3.text := edit3.text + M[i - 1] + M[i] + M[i + 1] + ' '; i := i + 2;
    end;
  until i > edit2.gettextlen;


{HECELERE AYIRMA İŞLEMİ SONU}

{FONEMLERE AYIRMA İŞLEMİ}
  i := 0;
  F := edit3.text;
  sesliler := ['A', 'E', 'I', 'İ', 'O', 'Ö', 'U', 'Ü', 'a', 'e', 'ı', 'i', 'o', 'ö', 'u', 'ü'];
  memo1.Clear;
  for i := 1 to edit3.gettextlen do
  begin
    if F[i] in sesliler then
    begin
      if ((F[i - 1] = ' ') and (F[i + 1] = ' ')) then memo1.lines.add(F[i]);
    end
    else
    begin
      if F[i] <> ' ' then
      begin
        if F[i - 1] in sesliler then memo1.lines.add(F[i - 1] + F[i]);
        if F[i + 1] in sesliler then memo1.lines.add(F[i] + F[i + 1]);
      end
    end

  end;
{FONEMLERE AYIRMA İŞLEMİ SONU}
{OKUMA İŞLEMİ}
  for i := 0 to memo1.lines.count do fonem[i] := 'c:\texttowav\texttowav\' + memo1.lines[i] + '.wav';
  for i := 0 to memo1.lines.count do
    PlaySound(pchar(fonem[i]), 0, SND_FILENAME + SND_SYNC);
{OKUMA SONU}
end;

end.

[baypipox]

pardon aceleyle oldu o yüzden bir dahaki sefere code içine alırım