AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Sprachausgabe

Ein Thema von riko.delphipraxis · begonnen am 15. Aug 2008 · letzter Beitrag vom 12. Sep 2008
Antwort Antwort
Seite 2 von 2     12   
Benutzerbild von Meflin
Meflin

Registriert seit: 21. Aug 2003
4.856 Beiträge
 
#11

Re: Sprachausgabe

  Alt 11. Sep 2008, 12:39
Zitat von riko.delphipraxis:
Ich kann eure Argumentation nicht ganz nachvollziehen...
Keine Sorge, du bist hier schon richtig
  Mit Zitat antworten Zitat
riko.delphipraxis

Registriert seit: 13. Aug 2008
12 Beiträge
 
#12

Re: Sprachausgabe

  Alt 11. Sep 2008, 20:22
OK, danke. Ich dachte schon ich habe Verständigungsprobleme...

Dann gibts hier also einen Ausschnitt aus meinem code...
Quick&Dirty aus meinen units kopiert... 8)

Alles relevante sollte dabei sein...

Delphi-Quellcode:
{* ENCODING STUFF ==========================================*}

Var
pcm2uLawMap : array[0..65535] of byte; // the encoding map

// create encoding map for faster processing
procedure TForm2.CreateMuLawMap;
Var i : Integer;
begin
   for i:=-32768 to 32767 do
     pcm2uLawMap[(i AND $ffff)] := pcm2ulaw(i);
end;

// create ulaw Byte from 16bit sample
function TForm2.pcm2ulaw(sample:smallint):byte;
var
  sign, exponent, mantissa, mask, seg:smallint;
  uval : Byte; // encoded return value

const
  BIAS = $84; // define the add-in bias for 16 bit samples
  CLIP = 8159; // define max value to clip magnitude
  seg_uend:array[0..7] of smallint = ($3F, $7F, $FF, $1FF, $3FF, $7FF, $FFF, $1FFF);

// search sample segment
function search(val,size : smallint) : smallint;
var i : smallint;
begin
  for i:=0 to size-1 do
    if (val <= seg_uend[i]) then
    begin
      result:=i;
      break;
    end;
  end;

begin
  // Get the sign and the magnitude of the value.
  sample := sample shr 2;
  if (sample < 0) then
  begin
    sample := -sample;
    mask := $7F;
  end else mask := $FF;
  if ( sample > CLIP ) then sample := CLIP; // clip the magnitude
  sample := (sample + BIAS) shr 2; // Convert the scaled magnitude to segment number.
  seg := search(sample,8);
  {* Combine the sign, segment, quantization bits;
   * and complement the code word. }

  if (seg >= 8) then       // out of range, return maximum value.
    result:= byte($7F XOR mask)
  else
  begin
    {* The mu-law byte bit arrangement
     * is SEEEMMMM (Sign, Exponent, and Mantissa.) }

    uval := byte((seg shl 4) or ((sample shr (seg + 1)) AND $F));
    result:= byte(uval XOR mask);
  end;
end;

// do the encoding of the record buffer
procedure TForm2.G711_Encode(inbuf: PByte; inlen: Integer; outbuf: PByte; var outlen: Integer);
var
  i: Integer;
begin
  for i:=0 to (inlen div 2)-1 do // 16bit to 8bit
    // take the value out of the map
    PByte(integer(outbuf)+i)^ := pcm2uLawMap[PSmallint(integer(inbuf)+i*2)^ AND $FFFF];
  outlen:=inlen div 2;
end;

{* ENCODING STUFF ==========================================*}

// constants for BASS initialization
const
  cDefaultDevice = -1; // Default Device Identifier
  cSampleRate = 8000; // PCM-Audio
  cNumChannels = 1; // Mono
  cRecordingTime = 100; // ms (10 - 500 ms / Default 100 ms)
  c16BitAudio = 0; // Flag für 16 Bit Audio 1=Nein
  cDefaultUser = nil; // UserIdentifier (not used)
  cDirectXPointer = nil; // Pointer für DirectX Class Identifier

// initializations on startup
procedure TForm1.doInit;
begin
  CreateMuLawMap;
end;

// button to make announcement
procedure TForm1.bAnnounceClick(Sender: TObject);
begin
  if BASS_ChannelIsActive(rchan) <> 0 then
    StopAnnouncement(activeCAM)
  else StartAnnouncement(activeCAM);
end;

// start the announcement
procedure TForm1.StartAnnouncement(iCAM : PcamItem);
Var Flag : DWORD;
begin
   Flag := MakeLong(c16BitAudio,cRecordingTime);
   RChan := BASS_RecordStart (cSampleRate,
                              cNumChannels,
                              Flag,
                              @RecordingCallback,
                              cDefaultUser);
   if rchan = 0 then
   begin
     MessageDlg('Fehler: Durchsage kann nicht gestartet werden!', mtError, [mbOk], 0);
     WaveStream.Clear;
   end else OpenCamSpeaker(iCAM);
end;

// stop the announcement
procedure TForm1.StopAnnouncement(iCAM : PcamItem);
begin
  iCAM^.SpeakerOpen := false;
  BASS_ChannelStop(rchan);
  iCAM^.tcp.Disconnect;
end;

// callback from BASS
function RecordingCallback(Handle: HRECORD; buffer: Pointer; length, user: DWord): boolean; stdcall;
Var mybuffer : Pointer;
    outlen : Integer;
    LocalBuffer : Pointer;
begin
  if activeCAM^.SpeakerOpen then
  begin
    GetMem(LocalBuffer,length);
    GetMem(myBuffer,length);
    CopyMemory(LocalBuffer,buffer,length);
    G711_Encode(LocalBuffer,length,mybuffer,outlen);
    activeCAM^.tcp.WriteBuffer(mybuffer^,outlen,true);
    FreeMem(mybuffer,length);
    FreeMem(LocalBuffer,length);
  end;
  result := True;
end;

// open connection to cam speaker
procedure TForm1.OpenCamSpeaker(iCAM : PcamItem);
Var send_dat: sysUtils.PByteArray;
    helper : String;
begin
  // connect to cam
  iCAM^.tcp.Host:=iCAM^.IP;
  iCAM^.tcp.Port:=iCAM^.port;
  if not iCAM^.tcp.Connected then iCAM^.tcp.Connect;
  // wait for connection established
  while not iCAM^.tcp.Connected do
  begin
    Application.ProcessMessages;
  end;

  // send opening header to cam
  getmem(send_dat,1024);
  helper:=helper + 'GET http://'+iCAM^.IP+'/audio-out/g711_64.cgi HTTP/1.1' + #13 + #10;
  helper:=helper + 'HOST: '+selfIP+ #13 + #10;
  helper:=helper + 'Connection: close'+ #13 + #10;
  helper:=helper + 'Authorization: Basic '+iCAM^.password+'+ #13 + #10 + #13 + #10;
move(helper[1],send_dat^[0],length(helper));
iCAM^.tcp.WriteBuffer(send_dat^[0],length(helper));
iCAM^.SpeakerOpen := true;
freemem(send_dat);
end;
  Mit Zitat antworten Zitat
hathor
(Gast)

n/a Beiträge
 
#13

Re: Sprachausgabe

  Alt 12. Sep 2008, 11:21
Der Titel ist immer noch falsch - SPRACHAUSGABE ist was anderes!

Gib mal in der Suchfunktion TextToSpeech ein, dann findest Du was über Sprachausgabe.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 2     12   


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:17 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz