Sprachausgabe

[Meflin]

Zitat:

Zitat von riko.delphipraxis

Ich kann eure Argumentation nicht ganz nachvollziehen... :gruebel:

Keine Sorge, du bist hier schon richtig ;)

[riko.delphipraxis]

OK, danke. Ich dachte schon ich habe Verständigungsprobleme... :lol:

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

Alles relevante sollte dabei sein... :hi:

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;

[hathor]

Der Titel ist immer noch falsch - SPRACHAUSGABE ist was anderes!

Gib mal in der Suchfunktion TextToSpeech ein, dann findest Du was über Sprachausgabe.