(******************************************************************************)
(* 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