Konuyu Paylaş : facebook gplus twitter

Konuyu Oyla:
  • Derecelendirme: 4/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Metini Sese Çevirme (TTS)
#1
Merhaba. Bir siteden kelimleri sese çeviren bir küçük projem var. Ve sesi indireceğim. Kaynak dil olarak İngiizce, Almanca, Türkçe, Azerice, Arap ve İspanyolca va. Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol

Bu benim küçük kod parçam.


var
 HTTP: TIdHTTP;

type
 Speakers = packed record
   id: integer;
   text: string;
   value: string;
 end;

const
 Langs: array[0..18] of Speakers =
 (
   (id: 1; text: 'Rae (Amerikan İngilizcesi Kadın)'; value: 'GVZ_Rae_16k'; ),
   (id: 2; text: 'Craig (Amerikan İngilizcesi Erkek)'; value: 'GVZ_Craig_16k'; ),
   (id: 3; text: 'Robin (Amerikan İngilizcesi Kadın)'; value: 'GVZ_Robin_16k'; ),
   (id: 4; text: 'Melissa (Amerikan İngilizcesi Kadın)'; value: 'GVZ_Melissa_16k'; ),
   (id: 5; text: 'Daniel (Amerikan İngilizcesi Erkek)'; value: 'GVZ_Daniel_16k'; ),
   (id: 6; text: 'Jessica (Amerikan İngilizcesi Kadın - Robotik)'; value: 'GVZ_Jessica_16k'; ),
   (id: 7; text: 'Athena (İngiliz İngilizcesi Kadın)'; value: 'GVZ_Athena_16k'; ),
   (id: 8; text: 'Gül Premium (Türkçe Kadın)'; value: 'GVZ_Gul_16k_HV_Premium'; ),
   (id: 9; text: 'Sinan Premium (Türkçe Erkek)'; value: 'GVZ_Sinan_16k_HV_Premium'; ),
   (id: 10; text: 'Çiğdem (Türkçe Kadın)'; value: 'GVZ_Cigdem_16k'; ),
   (id: 11; text: 'Delal (Arapça Kadın)'; value: 'GVZ_Delal_16k'; ),
   (id: 12; text: 'Tarik (Arapça Erkek)'; value: 'GVZ_Tarik_16k'; ),
   (id: 13; text: 'Marie (Fransızca Kadın)'; value: 'GVZ_Marie_16k'; ),
   (id: 14; text: 'Gladys (İspanyolca Kadın)'; value: 'GVZ_Gladys_16k'; ),
   (id: 15; text: 'Muntaha (Urduca Kadın-beta)'; value: 'GVZ_Muntaha_16k'; ),
   (id: 16; text: 'Annabella (Almanca Kadın)'; value: 'GVZ_Annabella_16k'; ),
   (id: 17; text: 'Johannes (Almanca Erkek)'; value: 'GVZ_Johannes_16k'; ),
   (id: 18; text: 'Ulviye (Azerice Kadın)'; value: 'GVZ_Ulviye_16k'; ),
   (id: 19; text: 'Murad (Azerice Erkek)'; value: 'GVZ_Murad_16k'; )
 );

function SubParse(Source, L, R: string): string;
begin
 Delete(Source, 1, Pos(L, Source) + Length(L) - 1);
 Result := Copy(Source, 1, Pos(R, Source) - 1);
end;

procedure GetSpeakers(List: TComboBox);
var
 I: Integer;
begin
 for I := 0 to 18 do
 begin
   List.Items.Add(Langs[I].text);
 end;
 List.ItemIndex := 0;
end;

procedure TMain.FormCreate(Sender: TObject);
begin
 GetSpeakers(Lang);
 HTTP := TIdHTTP.Create(nil);
end;

procedure TMain.FormDestroy(Sender: TObject);
begin
 HTTP.Free;
end;

procedure TMain.SyncClick(Sender: TObject);
var
 SL: TStringList;
 Temp: string;
begin
 Temp := HTTP.Get('http://212.15.10.146:8877/demo.aspx');
 SL := TStringList.Create;
 SL.Add('__EVENTTARGET=Button1');
 SL.Add('__EVENTARGUMENT=');
 SL.Add('__VIEWSTATE=');
 SL.Add('__VIEWSTATEGENERATOR=' + SubParse(Temp, 'GENERATOR" value="', '"'));
 SL.Add('__EVENTVALIDATION=' + SubParse(Temp, 'VALIDATION" value="', '"'));
 SL.Add('ddlVoices=' + Langs[Lang.ItemIndex].value);
 SL.Add('TextBox1=' + Text.Text);
 try
   HTTP.Post('http://212.15.10.146:8877/demo.aspx', SL);
 finally
   SL.Free;
 end;
end;

500 Internal Server Error hatası döndürüyor.
WWW
Cevapla
#2
Site ses dosyasını indirmene engel olabilir. Benzer servisler google ve yandex'in de var. Önceden Google servisinde seslendirme yapılan sayfa verilerini incelediğinde ses verisinin (adresi sallıyorum) speech.google.com/defter+kalem+al.mp3 adresinden çekildiğini görüyorsun. Bu adresi adres çubuğuna yazdığında dosyaya ulaşamıyorsun. Ancak daha önce ulaşmak mümkündü. Bir kaç ay önce denediğimde yandexte bu mümkündü.
Ağlarsa kablosuz ağlar, gerisi yerel ağlar...
Cevapla
#3
(08-04-2017, Saat: 21:20)engerex Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Giriş yap veya Üye OlSite ses dosyasını indirmene engel olabilir. Benzer servisler google ve yandex'in de var. Önceden Google servisinde seslendirme yapılan sayfa verilerini incelediğinde ses verisinin (adresi sallıyorum) speech.google.com/defter+kalem+al.mp3 adresinden çekildiğini görüyorsun. Bu adresi adres çubuğuna yazdığında dosyaya ulaşamıyorsun. Ancak daha önce ulaşmak mümkündü. Bir kaç ay önce denediğimde yandexte bu mümkündü.

İyi akşamlar. Bir yolu olmalı belki bir hata yapıyorumdur.
WWW
Cevapla
#4
Dostum google ile yapılmış bir örnek var. Belki işine yarar diye paylaşıyorum.  En altta nasıl kullanıldığını gösteren kod var.

Alıntı:Şimdi kullanım ile ilgili küçük bir örnek yazalım projenize uGTTS.pas kütüphanesini ekleyin.Yeni bir form açın ve üzerine yeni bir button ekleyin. Örnekte ki gibi sınıfı create edip SpeechNow ile direk yazıyı okutabilir yada TextToSpeech methodu ile mp3 dosyası olarak dosya yolunu alıp dilediğiniz gibi kullanabilirsiniz.

20.06.2014 de Sınıfta yaptığım bir değişlikle SpeechNow methoduna overload versiyon ekledim. Artık MediaPlayer’ı parametre olarak vermeden de sesleri çalabilirsiniz.

UGTTS Pas dosyası.

unit uGTTS;

interface

uses
 Windows, SysUtils, Variants, Classes, StrUtils, IdHTTP, HTTPApp, IdURI,
 ShellAPI, DateUtils, Forms, MPlayer, Controls;

const
 LANG_TR = 'tr';
 LANG_EN = 'en';
 LANG_DE = 'de';
 LANG_RU = 'ru';
 LANG_FR = 'fr';

Type
 /// <summary>
 /// <c>Google Text To Speech API</c> si yardımı ile yazıları sese çeviren kütüphanedir.
 /// Verilen yazıyı MP3 formatında geri gönderir. Ön bellekleme mekanizması ise
 /// daha önce sorgulanmış yazıları google'a yollamadan önce ön bellek klasöründe arar.
 /// Yazının ses karşılığı daha önce oluşturulmuş ise google servislerine istemde bulunmaz.
 /// Bu özellik varsayılan açıktır. İstenirse devre dışı bırakılabilir.
 /// </summary>
 /// <remarks>
 /// Bu sınıf <c>Ahmet ALTAY</c> tarafından <c>Google Text To Speech</c> kullanılarak geliştirilmiştir. Tarih: 16.06.2014
 /// </remarks>
 TGTTS = Class(TComponent)
 private const
   sURL: string = 'http://translate.google.com/translate_tts?ie=utf-8&tl=%s&q=%s';
   sTimeOut: Integer = 3000; // 3 second
 private
 { Private declarations }
   FTempPath: string;
   FUseCache: Boolean;
   FLanguage: string;
   FAppDir: string;
   FSpeechDir: string;
   FLastCalledURL: String;
   FLastConvertedMp3: String;
   FMediaPlayer: TMediaPlayer;
   function DelTree(const ADirName: string): Boolean;
 public
   /// <summary>
   /// Parametre ile verilen yazıyı, ses dosyasına dönüştürür.
   /// </summary>
   /// <param name="AText">Metin (100 karakteri geçmemesi tavsiye edilir.)</param>
   /// <returns>MP3 formatında dosya yolu döner.</returns>
   /// <remarks>
   /// Bu fonskyion Google servisleri aracılığı ile geliştirilmiştir. <seealso>http://translate.google.com</seealso>
   /// </remarks>
   /// <exception cref="EFCreateError">Klasör okuma/yazma izni yok veya dosya yolu hatalı.</exception>
   /// <exception cref="EIdSocketError ">Bağlantı hatası, İnternet erişimi yok veya yasaklı URL.</exception>
   /// <author>Ahmet ALTAY</author>
   function TextToSpeech(const AText: string): TFileName;
   /// <summary>
   /// Parametre ile verilen yazıyı, ses dosyasına dönüştürür ve MediaPlayer ile çalar.
   /// </summary>
   /// <param name="AText">Metin (100 karakteri geçmemesi tavsiye edilir.)</param>
   /// <param name="AMediaPlayer">Ses dosyasının yürütüleceği media player nesnesi.</param>
   /// <param name="ADontStopWhilePlaying">Media player'ın, dosya yürütme işlemini bitirene kadar beklemesi için true gönderin.</param>
   /// <remarks>
   /// Bu fonskyion Google servisleri aracılığı ile geliştirilmiştir. <seealso>http://translate.google.com</seealso>
   /// </remarks>
   /// <exception cref="EFCreateError">Klasör okuma/yazma izni yok veya dosya yolu hatalı.</exception>
   /// <exception cref="EIdSocketError ">Bağlantı hatası, İnternet erişimi yok veya yasaklı URL.</exception>
   /// <exception cref="EMCIDeviceError ">Media Player hatası, codec yok, dosya yolu hatalı veya erişim izni yok.</exception>
   /// <author>Ahmet ALTAY</author>
   procedure SpeechNow(const AText: string; const AMediaPlayer: TMediaPlayer; const ADontStopWhilePlaying: Boolean = True); overload;
   /// <summary>
   /// Parametre ile verilen yazıyı, ses dosyasına dönüştürür ve MediaPlayer ile çalar.
   /// </summary>
   /// <param name="AText">Metin (100 karakteri geçmemesi tavsiye edilir.)</param>
   /// <param name="ADontStopWhilePlaying">Media player'ın, dosya yürütme işlemini bitirene kadar beklemesi için true gönderin.</param>
   /// <remarks>
   /// Bu fonskyion Google servisleri aracılığı ile geliştirilmiştir. <seealso>http://translate.google.com</seealso>
   /// </remarks>
   /// <exception cref="EFCreateError">Klasör okuma/yazma izni yok veya dosya yolu hatalı.</exception>
   /// <exception cref="EIdSocketError ">Bağlantı hatası, İnternet erişimi yok veya yasaklı URL.</exception>
   /// <exception cref="EMCIDeviceError ">Media Player hatası, codec yok, dosya yolu hatalı veya erişim izni yok.</exception>
   /// <author>Ahmet ALTAY</author>
   procedure SpeechNow(const AText: string; const ADontStopWhilePlaying: Boolean = True); overload;
   /// <summary>
   /// Okutulan dosyanın işi bittikten sonra silmek için kullanılabilir.
   /// </summary>
   /// <returns>İşlem başarılı ise True, değilse False döner.</returns>
   /// <author>Ahmet ALTAY</author>
   function DeleteFile(const AFileName: string): Boolean;
   /// <summary>
   /// Ön bellekte biriken dosyaları temizlemek için kullanılır.
   /// </summary>
   /// <returns>İşlem başarılı ise True, değilse False döner.</returns>
   /// <author>Ahmet ALTAY</author>
   function ClearCache(): Boolean;
   /// <param name="ALanguage">Ses çevirisinde kullanılacak olan dil seçeneği.</param>
   /// <param name="AUseCache">Ön bellek kullanımı.</param>
   /// <author>Ahmet ALTAY</author>
   constructor Create(AOwner: TWinControl; const ALanguage: string = LANG_TR; const AUseCache: Boolean = True); overload;
   /// <param name="ATempPath">Dosyaların kayıt edileceği kök klasor yolu.</param>
   /// <param name="ALanguage">Ses çevirisinde kullanılacak olan dil seçeneği.</param>
   /// <param name="AUseCache">Ön bellek kullanımı.</param>
   /// <author>Ahmet ALTAY</author>
   constructor Create(AOwner: TWinControl; const ATempPath: string; const ALanguage: string = LANG_TR; const AUseCache: Boolean = True); overload;
   /// <param name="ATempPath">Dosyaların kayıt edileceği kök klasor yolu.</param>
   /// <param name="AAppDir">Temp içersine açılacak uygulamayı temsil eden klasör adı.</param>
   /// <param name="ASpeechDir">Uygulama klasörü içine açılacak. Ses dosyalarını içeren klasör adı.</param>
   /// <param name="ALanguage">Ses çevirisinde kullanılacak olan dil seçeneği.</param>
   /// <param name="AUseCache">Ön bellek kullanımı.</param>
   /// <author>Ahmet ALTAY</author>
   constructor Create(AOwner: TWinControl; const ATempPath: string; const AAppDir: string; const ASpeechDir: string; const ALanguage: string = LANG_TR; const AUseCache: Boolean = True); overload;
   destructor Destroy; override;
   /// <summary>Son çalıştırılan URL. <c>ReadOnly</c></summary>
   property LastCalledURL: String read FLastCalledURL;
   /// <summary>Son dönüştürülen MP3 dosyası. <c>ReadOnly</c></summary>
   property LastConvertedMp3: String read FLastConvertedMp3;
 end;

implementation

{ TGTTS }

constructor TGTTS.Create(AOwner: TWinControl; const ALanguage: string; const AUseCache: Boolean);
var
 lTempPath: array[0..MAX_PATH] of Char;
 lAppDir: String;
begin
 GetTempPath(Length(lTempPath), lTempPath);
 lAppDir := ReplaceStr(ExtractFileName(Application.ExeName),ExtractFileExt(Application.ExeName),'');
 Create(AOwner,lTempPath,lAppDir,'Speech',ALanguage,AUseCache);
end;

constructor TGTTS.Create(AOwner: TWinControl; const ATempPath, ALanguage: string; const AUseCache: Boolean);
var
 lAppDir: String;
begin
 lAppDir := ReplaceStr(ExtractFileName(Application.ExeName),ExtractFileExt(Application.ExeName),'');
 Create(AOwner,ATempPath,ExtractFileName(Application.ExeName),'Speech',ALanguage,AUseCache);
end;

constructor TGTTS.Create(AOwner: TWinControl; const ATempPath, AAppDir, ASpeechDir, ALanguage: string; const AUseCache: Boolean);
begin
 inherited Create(AOwner);
 FTempPath := ATempPath;
 FAppDir := AAppDir;
 FSpeechDir := ASpeechDir;
 FUseCache := AUseCache;
 FLanguage := ALanguage;
 FMediaPlayer := TMediaPlayer.Create(Self);
 FMediaPlayer.Parent := TWinControl(Self.Owner);
 FMediaPlayer.Visible := False;
 FMediaPlayer.Close;
end;

function TGTTS.ClearCache: Boolean;
begin
 if not DirectoryExists(FTempPath + FAppDir + '\' + FSpeechDir + '\') then
 begin
   Result := True;
   Exit;
 end;
 FMediaPlayer.Close;
 Result := DelTree(FTempPath + FAppDir + '\' + FSpeechDir + '\');
end;

function TGTTS.DeleteFile(const AFileName: string): Boolean;
begin
 Result := False;
 if FileExists(AFileName) then
   Result := SysUtils.DeleteFile(AFileName);
end;

function TGTTS.DelTree(const ADirName: string): Boolean;
var
 lSHFileOpStruct: TSHFileOpStruct;
 lDirBuf: array[0..MAX_PATH] of char;
begin
 try
   Fillchar(lSHFileOpStruct, Sizeof(lSHFileOpStruct), 0);
   FillChar(lDirBuf, Sizeof(lDirBuf), 0);
   StrPCopy(lDirBuf, ADirName);
   with lSHFileOpStruct do
   begin
     Wnd := 0;
     pFrom := @lDirBuf;
     wFunc := FO_DELETE;
     fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
   end;
   Result := SHFileOperation(lSHFileOpStruct) = 0;
 except
   Result := False;
 end;
end;

destructor TGTTS.Destroy;
begin
 FMediaPlayer.Close;
 FreeAndNil(FMediaPlayer);
 inherited Destroy;
end;

procedure TGTTS.SpeechNow(const AText: string; const ADontStopWhilePlaying: Boolean);
begin
 SpeechNow(AText,FMediaPlayer,ADontStopWhilePlaying);
end;

procedure TGTTS.SpeechNow(const AText: string; const AMediaPlayer: TMediaPlayer; const ADontStopWhilePlaying: Boolean);
var
 lFileName: TFileName;
begin
 lFileName := TextToSpeech(AText);
 if not FileExists(lFileName) then
   Exit;
 with AMediaPlayer do
 begin
   Close;
   FileName := lFileName;
   Open;
   Play;
   if ADontStopWhilePlaying then
   begin
     while Mode = mpPlaying do
       Application.ProcessMessages;
     Stop;
     Close;
   end;
 end;
end;

function TGTTS.TextToSpeech(const AText: String): TFileName;
var
 lHttp: TIdHTTP;
 lStream: TMemoryStream;
 lUrl, lFileName: string;
 lTempFile: array[0..MAX_PATH] of Char;
begin
 Result := '';
 if FUseCache then
 begin
   if not DirectoryExists(FTempPath + FAppDir) then
     CreateDirectory(PWideChar(FTempPath + FAppDir), nil);
   if not DirectoryExists(FTempPath + FAppDir + '\' + FSpeechDir) then
     CreateDirectory(PWideChar(FTempPath + FAppDir + '\' + FSpeechDir), nil);
   lFileName := FTempPath + FAppDir + '\' + FSpeechDir + '\' + AText + ' [' +FLanguage+ '].mp3'
 end
 else
 begin
   GetTempFileName(PWideChar(FTempPath), 'tts', 0, lTempFile);
   lFileName := ChangeFileExt(lTempFile, '.mp3');
 end;
 if (not FUseCache) or (not FileExists(lFileName)) then
 begin
   lStream := TMemoryStream.Create;
   try
     lUrl := TIdURI.URLEncode(Format(sURL, [FLanguage, AText]));
     FLastCalledURL := lUrl;
     lHttp := TIdHTTP.Create(nil);
     try
       lHttp.ConnectTimeout := sTimeOut;
       lHttp.ReadTimeout := sTimeOut;
       lHttp.Request.AcceptCharSet := 'UTF-8';
       lHttp.Get(lUrl, lStream);
     finally
       FreeAndNil(lHttp);
     end;
     if lStream.Size > 0 then
     begin
       lStream.Seek(0, 0);
       lStream.SaveToFile(lFileName);
     end;
   finally
     FreeAndNil(lStream);
   end;
 end;
 if FileExists(lFileName) then
 begin
   Result := lFileName;
   FLastConvertedMp3 := lFileName;
 end;
end;

end.


Kullanımı
procedure TForm1.Button1Click(Sender: TObject);
var
 lGtts: TGTTS;
begin
 lGtts := TGTTS.Create(Self);
 try
   lGtts.SpeechNow('Merhaba Dünya');
 finally
   FreeAndNil(lGtts);
 end;
end;
Cevapla

Konuyu Paylaş : facebook gplus twitter



Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  FastReport yazıya çevirme adelphiforumz 0 333 13-02-2018, Saat: 23:43
Son Yorum: adelphiforumz
  String Byte Dizisine Çevirme dicle_gsm 4 633 31-07-2017, Saat: 20:16
Son Yorum: dicle_gsm
  Sayıyı Yazıya Çevirme delphi-x 0 800 31-01-2017, Saat: 21:22
Son Yorum: delphi-x



Konuyu Okuyanlar: 1 Ziyaretçi