Einzelnen Beitrag anzeigen

Ducksoul

Registriert seit: 19. Apr 2006
Ort: Ilmenau
87 Beiträge
 
RAD-Studio 2009 Pro
 
#15

Re: "bass.dll" Aufnahme an beliebiger Stelle im St

  Alt 11. Sep 2008, 11:09
Guten Morgen,

also mein Code sieht nun wie folgt aus, aber das Rauschen besteht immernoch. Aber mir ist eingefallen woran es eventuell liegen könnte:

(* Angenommen ich nehme was auf, dann wird am Ende ja der Waveheader komplettiert. Nehme ich was neues auf, dann wird die vorige Datei mit kompletten Waveheader genommen und der Waveheader am Ende nochmal komplettiert und so weiter und sofort. Könnte das die Ursache sein? *)

Edit: Ich habe es jetzt so gelöst, dass der WaveStream ohne komplettierten Header in einen Zwischenspeicher BufStream2 gespeichert wird und beim Zusammenführen dann aus diesem gelesen wird und nicht aus dem WaveStream mit komplettierten Header.(siehe Code) Das Problem besteht trotzdem noch...

Wenn ja fragt sich dann nur noch, wie ich den Waveheader dann jedesmal zurückkomplettiere, um es mal so auszudrücken ^^


Delphi-Quellcode:
(******************************************************************************)
(*                             CallBack-Routine                               *)
(******************************************************************************)
  (* Callback WaveStream *)
  function RecordingCallback(Handle: HRECORD; buffer: Pointer; length, user: DWord): boolean; stdcall;
    begin
        // Kopiere neuen Bufferinhalt in den Memory Buffer
       Formular.WaveStream.Write(buffer^, length);
        // Weiteres Aufnehmen erlauben
       Result := True;

    end; // function Callback

  (* Callback InsertStream *)
  function RecordingInsertCallback(Handle: HRECORD; buffer: Pointer; length, user: DWord): boolean; stdcall;
    begin
        // Kopiere neuen Bufferinhalt in den Memory Buffer
       Formular.InsertStream.Write(buffer^, length);
        // Weiteres Aufnehmen erlauben
       Result := True;

    end;


(******************************************************************************)
(*                          Start und Stop Aufnahme                           *)
(******************************************************************************)
  (* Aufnahme Start *)
  procedure TFormular.StartRecording;
    var
      vol: Float;
      i: Integer;
      Flag: DWord;
    begin
      InsertRec := False;

      vol := RecordPegelBar.Position/100;
      while BASS_RecordSetInput(i, BASS_INPUT_OFF, vol)
        do i := i + 1;

      if WaveStream.Size = 0 then
        begin
           // Header für WAV-File generieren

           with WaveHdr do
            begin
                riff := 'RIFF';
                len := 36;
                cWavFmt := 'WAVEfmt ';
                dwHdrLen := 16;
                wFormat := 1;
                wNumChannels := 2;
                dwSampleRate := 44100;
                wBlockAlign := 4;
                dwBytesPerSec := 176400;
                wBitsPerSample := 16;
                cData := 'data';
                dwDataLen := 0;
            end; // with

           WaveStream.Write(WaveHdr, SizeOf(WAVHDR));
           i := 0;

            // ---LoWord-- ----HiWord----
          Flag := MakeLong(c16BitAudio, cRecordingTime);
           // Aufnahmebeginn @ 44100hz 16-bit stereo
           rchan := BASS_RecordStart(cSamplerate,
                                    cNumChannels,
                                    Flag,
                                    @RecordingCallback,
                                    nil);
        end
      else
        begin
          InsertRec := True;

          if Rec_Overwrite.Checked = True then
            begin
              try
                InsertPos := GetPos;
                InsertStream := TMemoryStream.Create;

                  // ---LoWord-- ----HiWord----
                Flag := MakeLong(c16BitAudio, cRecordingTime);
                   // Aufnahmebeginn @ 44100hz 16-bit stereo
                 rchan := BASS_RecordStart(cSamplerate,
                                          cNumChannels,
                                          Flag,
                                          @RecordingInsertCallback,
                                          nil);
              except
                InsertStream.Free;
              end; // try
            end; // if

          if Rec_Passage.Checked = True then
            begin
                // hier an aktueller Position Passage einfügen
            end; // if
        end; // if

         if rchan = 0
          then begin
              MessageDlg('Aufnahme konnte nicht gestartet werden!',
                        mtError, [mbOk], 0);
              WaveStream.Clear;
           end;
    end; // procedure StartRecording

  (* Stop recording *)
  procedure TFormular.StopRecording;
    var
       i: integer;
    begin
       BASS_ChannelStop(rchan);

      if InsertRec = True then
        begin
          if Rec_Overwrite.Checked = True then
            begin
                // hier Streams zusammenfügen /nach aktueller Posi fortfahren
              try
                BufStream := TMemoryStream.Create;
                BufStream2.Seek(0, soFromBeginning);
                BufStream.Write(BufStream2.Memory^, InsertPos);
                BufStream.Write(InsertStream.Memory^, InsertStream.Size);
                //BufStream.Write(PByteArray(WaveStream.Memory)^[InsertPos],WaveStream.Size-InsertPos);
                WaveStream.SetSize(BufStream.Size);
                Move(BufStream.Memory^, WaveStream.Memory^, BufStream.Size);
              finally
                FreeAndNil(BufStream);
                FreeAndNil(BufStream2);
                FreeAndNil(InsertStream);
              end; // try
          end; // if

          if Rec_Passage.Checked = True then
            begin
                // hier BufStream nach neuer Passage anfügen
          end; // if
      end; // if

      try
        BufStream2 := TMemoryStream.Create;
        BufStream2.CopyFrom(WaveStream, 0);
      except
        FreeAndNil(BufStream2);
      end; // try

         // WAV-Header komplettieren
       WaveStream.Position := 4;
       i := WaveStream.Size - 8;
       WaveStream.Write(i, 4);
       i := i - $24;
       WaveStream.Position := 40;
       WaveStream.Write(i, 4);
       WaveStream.Position := 0;

         // Stream für aufgenomme Daten kreieren
       chan := BASS_StreamCreateFile(True, WaveStream.Memory, 0, WaveStream.Size, 0);


       if chan <> 0
        then begin
          //???
         end
      else begin
          MessageDlg('Fehler beim Erstellen eines Streams aus der Aufnahme!',
                    mtError, [mbOk], 0);
        end; // if
    end; // procedure StopRecording
Edit2:
An folgenden Sachen liegt es denk ich mal nich, aber der Vollständigkeit halber will ich sie trotzdem ma noch reinstellen.

Delphi-Quellcode:
  (* Update der Progressbar *)
  procedure TFormular.RecordTimerTimer(Sender: TObject);
    var t, t2: integer;
    begin
      ProgressBar.OnChange := nil;
      ProgressBar.Position := Round((BASS_ChannelGetPosition(chan, BASS_POS_BYTE) / BASS_ChannelGetLength(chan, BASS_POS_BYTE)) * 100);
      ProgressBar.OnChange := ProgressBarChange;

      if (chan <> 0) then
        begin
          t := Round(BASS_ChannelBytes2Seconds(chan,
                    BASS_ChannelGetPosition(chan, BASS_POS_BYTE)));
          t2 := Round(BASS_ChannelBytes2Seconds(chan,
                    BASS_ChannelGetLength(chan, BASS_POS_BYTE)));
        progresstimeLabel.Caption := Format('%.2d:%.2d',[t Div 60, t Mod 60]);
        completetimeLabel.Caption := Format('%.2d:%.2d',[t2 Div 60, t2 Mod 60]);
        end;

    end; // procedure RecordTimerTimer

  (* Position via ProgressBar ändern *)
  procedure TFormular.ProgressBarChange(Sender: TObject);
  var Bool: Boolean;
  begin
    Bool := BASS_ChannelIsActive(chan) = BASS_ACTIVE_Playing;

    if Bool then BASS_ChannelPause(chan);

    BASS_ChannelSetPosition(chan, ProgressBar.Position
    * BASS_ChannelGetLength(chan, BASS_POS_BYTE) div 100, BASS_POS_BYTE);

    if Bool then BASS_ChannelPlay(chan, False);

  end; // procedure ProgressBarChange

  (* Position des Chans ermitteln *)
  function TFormular.GetPos: Integer;
    begin
      Result := Round((ProgressBar.Position
                      * BASS_ChannelGetLength(chan, BASS_POS_BYTE)) / 100);
    end; // function GetPos
Franz
  Mit Zitat antworten Zitat