home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / Delphi / RecordTest / Unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2005-09-14  |  7.1 KB  |  295 lines
  1. (*
  2.  *  BASS Recording example for Delphi
  3.  *)
  4.  
  5. unit Unit1;
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  11.   StdCtrls, Bass, ExtCtrls, ComCtrls;
  12.  
  13. type
  14.   WAVHDR = packed record
  15.     riff:            array[0..3] of Char;
  16.     len:            DWord;
  17.     cWavFmt:        array[0..7] of Char;
  18.     dwHdrLen:        DWord;
  19.     wFormat:        Word;
  20.     wNumChannels:    Word;
  21.     dwSampleRate:    DWord;
  22.     dwBytesPerSec:    DWord;
  23.     wBlockAlign:    Word;
  24.     wBitsPerSample:    Word;
  25.     cData:            array[0..3] of Char;
  26.     dwDataLen:        DWord;
  27.   end;
  28.  
  29. type
  30.   TForm1 = class(TForm)
  31.     ComboBox1: TComboBox;
  32.     bRecord: TButton;
  33.     bPlay: TButton;
  34.     Label1: TLabel;
  35.     TrackBar1: TTrackBar;
  36.     Bevel1: TBevel;
  37.     bSave: TButton;
  38.     lPos: TLabel;
  39.     PosTimer: TTimer;
  40.     SaveDialog: TSaveDialog;
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  43.     procedure FormDestroy(Sender: TObject);
  44.     procedure bRecordClick(Sender: TObject);
  45.     procedure bPlayClick(Sender: TObject);
  46.     procedure ComboBox1Change(Sender: TObject);
  47.     procedure StartRecording;
  48.     procedure StopRecording;
  49.     procedure PosTimerTimer(Sender: TObject);
  50.     procedure UpdateInputInfo;
  51.     procedure TrackBar1Change(Sender: TObject);
  52.     procedure bSaveClick(Sender: TObject);
  53.   private
  54.     { Private declarations }
  55.     WaveStream: TMemoryStream;
  56.   public
  57.     { Public declarations }
  58.   end;
  59.  
  60.  
  61. var
  62.   Form1:   TForm1;
  63.   WaveHdr: WAVHDR;  // WAV header
  64.   rchan:   HRECORD;    // recording channel
  65.   chan:    HSTREAM;    // playback channel
  66.  
  67.  
  68. implementation
  69.  
  70. {$R *.dfm}
  71.  
  72.  
  73. (* This is called while recording audio *)
  74. function RecordingCallback(Handle: HRECORD; buffer: Pointer; length, user: DWord): boolean; stdcall;
  75. begin
  76.     // Copy new buffer contents to the memory buffer
  77.     Form1.WaveStream.Write(buffer^, length);
  78.     // Allow recording to continue
  79.     Result := True;
  80. end;
  81.  
  82.  
  83. (* Initialize BASS, form controls, memory stream *)
  84. procedure TForm1.FormCreate(Sender: TObject);
  85. var
  86.   i: Integer;
  87.   dName: PChar;
  88. begin
  89.     if BASS_GetVersion <> DWord(MAKELONG(2,2)) then
  90.     begin
  91.         MessageDlg('BASS version 2.2 was not loaded!', mtError, [mbOk], 0);
  92.         Halt;
  93.     end;
  94.     if (not BASS_RecordInit(-1)) or (not BASS_Init(-1, 44100, 0, Handle, nil)) then
  95.     begin
  96.         BASS_RecordFree;
  97.         BASS_Free();
  98.         MessageDlg('Cannot start default recording device!', mtError, [mbOk], 0);
  99.         Halt;
  100.     end;
  101.     WaveStream := TMemoryStream.Create;
  102.     i := 0;
  103.     dName := BASS_RecordGetInputName(i);
  104.     while dName <> nil do
  105.     begin
  106.         ComboBox1.Items.Add(StrPas(dName));
  107.         // is this one currently "on"?
  108.         if (BASS_RecordGetInput(i) and BASS_INPUT_OFF) = 0 then
  109.             ComboBox1.ItemIndex := i;
  110.         Inc(i);
  111.         dName := BASS_RecordGetInputName(i);
  112.     end;
  113.     ComboBox1Change(Self);    // display info
  114. end;
  115.  
  116.  
  117. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  118. begin
  119.     Action := caFree;
  120. end;
  121.  
  122.  
  123. (* Application closing, release stuff *)
  124. procedure TForm1.FormDestroy(Sender: TObject);
  125. begin
  126.     WaveStream.Free;
  127.     BASS_RecordFree;
  128.     BASS_Free;
  129.     BASS_Stop;
  130. end;
  131.  
  132.  
  133. (* Start recording to memory *)
  134. procedure TForm1.StartRecording;
  135. var
  136.   i: Integer;
  137. begin
  138.     if ComboBox1.ItemIndex < 0 then Exit;
  139.     if WaveStream.Size > 0 then
  140.     begin    // free old recording
  141.         BASS_StreamFree(chan);
  142.         WaveStream.Clear;
  143.     end;
  144.     // generate header for WAV file
  145.     with WaveHdr do
  146.     begin
  147.         riff := 'RIFF';
  148.         len := 36;
  149.         cWavFmt := 'WAVEfmt ';
  150.         dwHdrLen := 16;
  151.         wFormat := 1;
  152.         wNumChannels := 2;
  153.         dwSampleRate := 44100;
  154.         wBlockAlign := 4;
  155.         dwBytesPerSec := 176400;
  156.         wBitsPerSample := 16;
  157.         cData := 'data';
  158.         dwDataLen := 0;
  159.     end;
  160.     WaveStream.Write(WaveHdr, SizeOf(WAVHDR));
  161.     i := 0;
  162.     while BASS_RecordSetInput(i, BASS_INPUT_OFF) do i := i + 1;
  163.     BASS_RecordSetInput(ComboBox1.ItemIndex, BASS_INPUT_ON);
  164.     // start recording @ 44100hz 16-bit stereo
  165.     rchan := BASS_RecordStart(44100, 2, 0, @RecordingCallback, 0);
  166.     if rchan = 0 then
  167.     begin
  168.         MessageDlg('Couldn''t start recording!', mtError, [mbOk], 0);
  169.         WaveStream.Clear;
  170.     end
  171.     else
  172.     begin
  173.         bRecord.Caption := 'Stop';
  174.         bPlay.Enabled := False;
  175.         bSave.Enabled := False;
  176.     end;
  177. end;
  178.  
  179.  
  180. (* Stop recording *)
  181. procedure TForm1.StopRecording;
  182. var
  183.     i: integer;
  184. begin
  185.     BASS_ChannelStop(rchan);
  186.     bRecord.Caption := 'Record';
  187.     // complete the WAV header
  188.     WaveStream.Position := 4;
  189.     i := WaveStream.Size - 8;
  190.     WaveStream.Write(i, 4);
  191.     i := i - $24;
  192.     WaveStream.Position := 40;
  193.     WaveStream.Write(i, 4);
  194.     WaveStream.Position := 0;
  195.     // create a stream from the recorded data
  196.     chan := BASS_StreamCreateFile(True, WaveStream.Memory, 0, WaveStream.Size, 0);
  197.     if chan <> 0 then
  198.     begin
  199.         // enable "Play" & "Save" buttons
  200.         bPlay.Enabled := True;
  201.         bSave.Enabled := True;
  202.     end
  203.     else
  204.         MessageDlg('Error creating stream from recorded data!', mtError, [mbOk], 0);
  205. end;
  206.  
  207.  
  208. (* Start/stop recording *)
  209. procedure TForm1.bRecordClick(Sender: TObject);
  210. begin
  211.     if BASS_ChannelIsActive(rchan) <> 0
  212.         then StopRecording
  213.         else StartRecording;
  214. end;
  215.  
  216.  
  217. (* Play the recorded data *)
  218. procedure TForm1.bPlayClick(Sender: TObject);
  219. begin
  220.     BASS_ChannelPlay(chan, True);
  221. end;
  222.  
  223.  
  224. (* Change recording input *)
  225. procedure TForm1.ComboBox1Change(Sender: TObject);
  226. var
  227.     i: Integer;
  228.     r: Boolean;
  229. begin
  230.     // enable the selected input
  231.     r := True;
  232.     i := 0;
  233.     // first disable all inputs, then...
  234.     while r do
  235.     begin
  236.         r := BASS_RecordSetInput(i, BASS_INPUT_OFF);
  237.         Inc(i);
  238.     end;
  239.     // ...enable the selected.
  240.     BASS_RecordSetInput(ComboBox1.ItemIndex, BASS_INPUT_ON);
  241.     UpdateInputInfo;     // update info
  242. end;
  243.  
  244.  
  245. procedure TForm1.UpdateInputInfo;
  246. var
  247.     i: DWord;
  248. begin
  249.     i := BASS_RecordGetInput(ComboBox1.ItemIndex);
  250.     TrackBar1.Position := LoWord(i);    // set the level slider
  251.     case (i and BASS_INPUT_TYPE_MASK) of
  252.         BASS_INPUT_TYPE_DIGITAL: Label1.Caption := 'digital';
  253.         BASS_INPUT_TYPE_LINE: Label1.Caption := 'line-in';
  254.         BASS_INPUT_TYPE_MIC: Label1.Caption := 'microphone';
  255.         BASS_INPUT_TYPE_SYNTH: Label1.Caption := 'midi synth';
  256.         BASS_INPUT_TYPE_CD: Label1.Caption := 'analog cd';
  257.         BASS_INPUT_TYPE_PHONE: Label1.Caption := 'telephone';
  258.         BASS_INPUT_TYPE_SPEAKER: Label1.Caption := 'pc speaker';
  259.         BASS_INPUT_TYPE_WAVE: Label1.Caption := 'wave/pcm';
  260.         BASS_INPUT_TYPE_AUX: Label1.Caption := 'aux';
  261.         BASS_INPUT_TYPE_ANALOG: Label1.Caption := 'analog';
  262.     else
  263.         Label1.Caption := 'undefined';
  264.     end;
  265. end;
  266.  
  267.  
  268. (* Update rec/playback position display *)
  269. procedure TForm1.PosTimerTimer(Sender: TObject);
  270. begin
  271.     if WaveStream.Size < 1 then Exit;
  272.     if BASS_ChannelIsActive(chan) = BASS_ACTIVE_STOPPED then
  273.         lPos.Caption := IntToStr(WaveStream.Size) else
  274.         lPos.Caption := IntToStr(BASS_ChannelGetPosition(chan)) + ' / ' + IntToStr(WaveStream.Size);
  275. end;
  276.  
  277.  
  278. (* Set recording volume *)
  279. procedure TForm1.TrackBar1Change(Sender: TObject);
  280. begin
  281.     BASS_RecordSetInput(ComboBox1.ItemIndex, BASS_INPUT_LEVEL or TrackBar1.Position);
  282. end;
  283.  
  284.  
  285. (* Save recorded audio to WAV file *)
  286. procedure TForm1.bSaveClick(Sender: TObject);
  287. begin
  288.     if SaveDialog.Execute then
  289.         WaveStream.SaveToFile(SaveDialog.FileName);
  290. end;
  291.  
  292.  
  293. end.
  294.  
  295.