interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, ToolWin,
ActnMan, ActnCtrls, ActnMenus, XPStyleActnCtrls, Buttons, Grids, ValEdit,
ActnList, ShellCtrls, ImgList, Bass, inifiles, ShellAPI, Menus;
const
cDefaultDevice = -1;
// Default Device Identifier
cSampleRate = 44100;
// PCM-Audio
cNumChannels = 2;
// Stereo
cBlockLength = 4;
// 2*2 Bytes pro Speicherblock im Buffer
cRecordingTime = 200;
// Millisekunden (10 - 500 ms / Default 100 ms)
c16BitAudio = 0;
// Flag für 16 Bit Audio
cMaxAudio = 32768;
// maximaler Pegel bei 16 Bit
cDefaultUser = 0;
// UserIdentifier (not used)
cDirectXPointer =
nil;
// Default-Pointer für DirectX Class Identifier
Le = 0;
// Left Channel
Ri = 1;
// Right Channel
um_MusicEnd = wm_User + 400;
type
WAVHDR =
packed record
riff:
array[0..3]
of Char;
len: DWord;
cWavFmt:
array[0..7]
of Char;
dwHdrLen: DWord;
wFormat: Word;
wNumChannels: Word;
dwSampleRate: DWord;
dwBytesPerSec: DWord;
wBlockAlign: Word;
wBitsPerSample: Word;
cData:
array[0..3]
of Char;
dwDataLen: DWord;
end;
type
TRecordForm =
class(TForm)
RecordControlBar: TControlBar;
RecordMainMenu: TActionMainMenuBar;
ListPnl: TPanel;
RecordSplitter: TSplitter;
RecorderPnl: TPanel;
RecordTimer: TTimer;
RecActionList: TActionList;
Rec: TAction;
Stop: TAction;
Play: TAction;
Start: TAction;
Previous: TAction;
Next: TAction;
Ende: TAction;
DiktatListView2: TShellListView;
ToolActionManager: TActionManager;
ActionToolBar1: TActionToolBar;
RecImageList: TImageList;
Save: TAction;
RecSaveDialog: TSaveDialog;
Open: TAction;
OpenDialog1: TOpenDialog;
RecImageList2: TImageList;
MenuActionManager: TActionManager;
VisualTimer: TTimer;
RecGroupBox: TGroupBox;
AufnahmeRadioGroup: TRadioGroup;
EndRadioButton: TRadioButton;
InsertRadioButton: TRadioButton;
OverWriteRadioButton: TRadioButton;
SettingsGroupBox: TGroupBox;
InputLbl: TLabel;
VolumeLbl: TLabel;
VolumePegelBar: TTrackBar;
RecordPegelBar: TTrackBar;
VisPanel: TPanel;
ProgressBar: TTrackBar;
VisPaintBox: TPaintBox;
SaveSend: TAction;
SendAs: TAction;
ShellPUM: TPopupMenu;
DictSendAs: TMenuItem;
DeletePrev: TAction;
DeleteFollowing: TAction;
InsPassage: TAction;
procedure FormActivate(Sender: TObject);
procedure SaveSendExecute(Sender: TObject);
procedure SendAsExecute(Sender: TObject);
procedure DiktatListView2DblClick(Sender: TObject);
procedure VisualTimerTimer(Sender: TObject);
procedure OpenExecute(Sender: TObject);
procedure SaveExecute(Sender: TObject);
procedure EndeExecute(Sender: TObject);
procedure StartExecute(Sender: TObject);
procedure PlayExecute(Sender: TObject);
procedure StopExecute(Sender: TObject);
procedure RecExecute(Sender: TObject);
procedure ProgressBarChange(Sender: TObject);
procedure VolumePegelBarChange(Sender: TObject);
procedure RecordPegelBarChange(Sender: TObject);
procedure RecordTimerTimer(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StartRecording;
procedure StopRecording;
private
EndSync: HSync;
WaveStream: TMemoryStream;
BufStream: TMemoryStream;
ChannelVol: Integer;
procedure ToggleStatus(
const Status: Integer);
procedure ReadConfig;
protected
procedure MusicEnd(
var Msg: TMessage);
message um_MusicEnd;
public
FRecordingsPath, User:
string;
AnhangDir:
String;
end;
procedure SyncProc(
Handle: HSync; Channel, Data: DWORD; User: DWORD);
stdcall;
var
RecordForm: TRecordForm;
WaveHdr: WAVHDR;
// WAV header
rchan: HRECORD;
// Aufnahmekanal
chan: HSTREAM;
// Wiedergabekanal
mic: integer;
volume: Float;
input: Float;
implementation
(******************************************************************************)
(* CallBack-Routine *)
(******************************************************************************)
(* Callback *)
function RecordingCallback(
Handle: HRECORD; buffer: Pointer; length, user: DWord): boolean;
stdcall;
begin
// Kopiere neuen Bufferinhalt in den Memory Buffer
RecordForm.WaveStream.
Write(buffer^, length);
// Weiteres Aufnehmen erlauben
Result := True;
end;
// function Callback
(******************************************************************************)
(* Start und Stop Aufnahme *)
(******************************************************************************)
(* Aufnahme Start *)
procedure TRecordForm.StartRecording;
var
vol: Float;
i: Integer;
Flag: DWord;
begin
// Aufnahme je nach Aufnahmemodus
if OverwriteRadioButton.Checked = True
then begin
if WaveStream.Size > 0
then begin
// alte Aufnahme löschen
BASS_StreamFree(chan);
WaveStream.Clear;
end;
// if
end
else if InsertRadioButton.Checked = True
then begin
WaveStream.Position := ProgressBar.Position;
end
else if EndRadioButton.Checked = True
then begin
WaveStream.Position := WaveStream.Size;
ProgressBar.Position := ProgressBar.Max;
end;
// if
// 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;
vol := RecordPegelBar.Position/100;
while BASS_RecordSetInput(i, BASS_INPUT_OFF, vol)
do i := i + 1;
// ---LoWord-- ----HiWord----
Flag := MakeLong(c16BitAudio, cRecordingTime);
// Aufnahmebeginn @ 44100hz 16-bit stereo
rchan := BASS_RecordStart(cSamplerate,
cNumChannels,
Flag,
@RecordingCallback,
nil);
if rchan = 0
then begin
MessageDlg('
Aufnahme konnte nicht gestartet werden!',
mtError, [mbOk], 0);
WaveStream.Clear;
end;
end;
// procedure StartRecording
(* Stop recording *)
procedure TRecordForm.StopRecording;
var
i: integer;
begin
BASS_ChannelStop(rchan);
// 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
ProgressBar.Max := WaveStream.Size;
BASS_ChannelSetPosition(chan, ProgressBar.Max, BASS_POS_BYTE);
ProgressBar.Position := BASS_ChannelGetPosition(chan, BASS_POS_BYTE);
end
else begin
MessageDlg('
Fehler beim Erstellen eines Streams aus der Aufnahme!',
mtError, [mbOk], 0);
end;
// if
end;
// procedure StopRecording
(* RecordButtonClick || Start Aufnahme *)
procedure TRecordForm.RecExecute(Sender: TObject);
begin
if BASS_ChannelIsActive(rchan) = BASS_Active_Stopped
then // Aufnahme starten
begin
if BASS_ChannelIsActive(chan) <> BASS_Active_Stopped
then
begin
BASS_ChannelStop(chan);
ProgressBar.Position := ProgressBar.Max;
StartRecording;
end
else
begin
ProgressBar.Position := ProgressBar.Max;
StartRecording;
end;
// if
ToggleStatus(8);
end
else if BASS_ChannelIsActive(rchan) = BASS_Active_Playing
then // Aufnahme beenden
begin
StopRecording;
ToggleStatus(3);
end;
end;
//procedure RecExecute
(* StopButtonClick || Stop Aufnahme *)
procedure TRecordForm.StopExecute(Sender: TObject);
begin
case BASS_ChannelIsActive(chan)
of
BASS_Active_Stopped:
begin
BASS_ChannelSetPosition(chan, 0, BASS_POS_BYTE);
ProgressBar.Position := BASS_ChannelGetPosition(chan, BASS_POS_BYTE);
ToggleStatus(3);
end;
// case BASS_Active_Stopped
BASS_Active_Playing:
begin
BASS_ChannelStop(chan);
BASS_ChannelSetPosition(chan, 0, BASS_POS_BYTE);
ProgressBar.Position := BASS_ChannelGetPosition(chan, BASS_POS_BYTE);
ToggleStatus(3);
end;
// case BASS_Active_Playing
BASS_Active_Paused:
begin
BASS_ChannelStop(chan);
BASS_ChannelSetPosition(chan, 0, BASS_POS_BYTE);
ProgressBar.Position := BASS_ChannelGetPosition(chan, BASS_POS_BYTE);
ToggleStatus(3);
end;
// case BASS_Active_Paused
end;
//case
end;
// procedure StopExecute
procedure SyncProc(
Handle: HSync; Channel, Data: DWORD; User: DWORD);
stdcall;
begin
PostMessage(RecordForm.Handle, um_MusicEnd, 0, 0);
end;
(* PlayButtonClick || Wiedergabe der Aufnahme *)
procedure TRecordForm.PlayExecute(Sender: TObject);
begin
case BASS_ChannelIsActive(chan)
of
BASS_Active_Stopped:
begin
BASS_ChannelPlay(chan, True);
EndSync := Bass_ChannelSetSync(chan, Bass_SYNC_END, 0, @SyncProc,
nil);
ToggleStatus(1);
end;
BASS_Active_Playing:
begin
BASS_ChannelPause(chan);
ToggleStatus(2);
end;
BASS_Active_Paused:
begin
BASS_ChannelPlay(chan, False);
ToggleStatus(1);
end;
end;
// case
end;
// procedure PlayExecute
procedure TRecordForm.MusicEnd(
var Msg: TMessage);
begin
// hier wird reingesprungen wenn der Stream endet
// der mit ..
MessageDlg('
Dies ist ein Test.');
// vorher in deiner Play Function initialisiert wurde (**** nicht hier ****)
// hier sollte dann dein Code stehen was du tun willst wenn der stream beendet ist.
end;
end.