home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / Delphi / writewav / UnitMain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2005-09-14  |  5.1 KB  |  162 lines
  1. {
  2.  Source code under Bass license
  3.  by Alessandro Cappellozza
  4.  
  5.  http://digilander.libero.it/Kappe
  6.  mail acappellozza@ieee.org
  7.  
  8.  Notice
  9.   It is designed for mp3 but work on other streams (ogg, and so on)
  10.  }
  11.  
  12. unit UnitMain;
  13.  
  14. interface
  15.  
  16. uses
  17.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  18.   Bass, StdCtrls, ComCtrls, ExtCtrls;
  19.  
  20. type
  21.   TForm1 = class(TForm)
  22.     EditFileName: TEdit;
  23.     EditDest: TEdit;
  24.     btnOpen: TButton;
  25.     BtnDecode: TButton;
  26.     OpenDialog: TOpenDialog;
  27.     btnCancel: TButton;
  28.     ProgressBar: TProgressBar;
  29.     LabelOp: TLabel;
  30.     Label1: TLabel;
  31.     Label2: TLabel;
  32.     Bevel1: TBevel;
  33.     Bevel2: TBevel;
  34.     Label3: TLabel;
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  37.     procedure BtnDecodeClick(Sender: TObject);
  38.     procedure btnOpenClick(Sender: TObject);
  39.     procedure btnCancelClick(Sender: TObject);
  40.   private
  41.     { Private declarations }
  42.   public
  43.     { Public declarations }
  44.      procedure DecodeFile(OutPath, SourceFileName : String);
  45.   end;
  46.  
  47. var
  48.   Form1: TForm1;
  49.   PercentDone : Integer;
  50.   CancelOp    : Boolean;
  51.   
  52. implementation
  53.  
  54. {$R *.dfm}
  55.  
  56. procedure TForm1.DecodeFile(OutPath, SourceFileName : String);
  57.  var chan, frq, vl : DWORD; Tmp: Integer;
  58.      buf : array [0..10000] of DWORD;
  59.    BytesRead : integer;
  60.    temp : string;
  61.    i : longint;
  62.    RecStream : TFileStream;
  63.    nChannels       : Word;   // number of channels (i.e. mono, stereo, etc.)
  64.    nSamplesPerSec  : DWORD;  // sample rate
  65.    nAvgBytesPerSec : DWORD;
  66.    nBlockAlign     : Word;
  67.    wBitsPerSample  : Word;   // number of bits per sample of mono data
  68.    FileName : String;
  69.    chaninfo: BASS_CHANNELINFO;
  70. begin
  71.  
  72.     chan := BASS_StreamCreateFile(FALSE, PChar(SourceFileName), 0, 0, BASS_STREAM_DECODE);
  73.  
  74.     CancelOp := False;
  75.     LabelOp.Caption      := 'Opening file ...';
  76.  
  77.   BASS_ChannelGetInfo(chan, chaninfo);
  78.     nChannels := chaninfo.chans;
  79.         if (chaninfo.flags and BASS_SAMPLE_8BITS > 0) then wBitsPerSample := 8 else wBitsPerSample := 16;
  80.     nBlockAlign := nChannels * wBitsPerSample div 8;
  81.     BASS_ChannelGetAttributes(chan, frq, vl, Tmp);
  82.         nSamplesPerSec := frq;
  83.     nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
  84.  
  85.     FileName := ExtractFileName(SourceFileName);
  86.     FileName := Copy(FileName, 1, Length(FileName) - Length(ExtractFileExt(FileName)));
  87.     RecStream := TFileStream.Create(OutPath + FileName + '.wav', fmCreate);
  88.  
  89.  // Write header portion of wave file
  90.     temp := 'RIFF'; RecStream.write(temp[1], length(temp));
  91.     temp := #0#0#0#0; RecStream.write(temp[1], length(temp));   // File size: to be updated
  92.     temp := 'WAVE'; RecStream.write(temp[1], length(temp));
  93.     temp := 'fmt '; RecStream.write(temp[1], length(temp));
  94.     temp := #$10#0#0#0; RecStream.write(temp[1], length(temp)); // Fixed
  95.     temp := #1#0; RecStream.write(temp[1], length(temp));       // PCM format
  96.     if nChannels = 1 then
  97.        temp := #1#0
  98.     else
  99.        temp := #2#0;
  100.     RecStream.write(temp[1], length(temp));
  101.     RecStream.write(nSamplesPerSec, 2);
  102.     temp := #0#0; RecStream.write(temp[1], length(temp));   // SampleRate is given as dWord
  103.     RecStream.write(nAvgBytesPerSec, 4);
  104.     RecStream.write(nBlockAlign, 2);
  105.     RecStream.write(wBitsPerSample, 2);
  106.     temp := 'data'; RecStream.write(temp[1],length(temp));
  107.     temp := #0#0#0#0; RecStream.write(temp[1],length(temp)); // Data size: to be updated
  108.     BytesRead := 1024 * 10; // 10kBytes
  109.     while (BASS_ChannelIsActive(chan) > 0) do
  110.          begin
  111.                 BASS_ChannelGetData(chan, @buf, BytesRead);
  112.                 RecStream.Write(buf, BytesRead);
  113.                 Application.ProcessMessages;
  114.                 if CancelOp then Break;
  115.                 PercentDone := Trunc(100 * (BASS_ChannelGetPosition(Chan) / BASS_ChannelGetLength(chan)));
  116.                 ProgressBar.Position := PercentDone;
  117.                 LabelOp.Caption      := 'Done ' + IntToStr(PercentDone) + '%';
  118.     end;
  119.  
  120.    LabelOp.Caption      := 'Closing file ...';
  121. // complete WAV header
  122. // Rewrite some fields of header
  123.    i := RecStream.Size - 8;    // size of file
  124.    RecStream.Position := 4;
  125.    RecStream.write(i, 4);
  126.    i := i - $24;               // size of data
  127.    RecStream.Position := 40;
  128.    RecStream.write(i, 4);
  129.    RecStream.Free;
  130.    LabelOp.Caption      := 'Done';
  131. end;
  132.  
  133. procedure TForm1.FormCreate(Sender: TObject);
  134. begin
  135.      BASS_Init(-1, 44100, 0, Application.Handle, nil);
  136. end;
  137.  
  138. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  139. begin
  140. Bass_Free;
  141. end;
  142.  
  143. procedure TForm1.BtnDecodeClick(Sender: TObject);
  144. begin
  145.  DecodeFile(EditDest.Text, EditFileName.Text);
  146. end;
  147.  
  148. procedure TForm1.btnOpenClick(Sender: TObject);
  149. begin
  150.  if not OpenDialog.Execute then exit;
  151.   EditFileName.text := OpenDialog.FileName;
  152.   EditDest.Text     := ExtractFileDir(OpenDialog.FileName);
  153.   if EditDest.Text[Length(EditDest.Text)] <> '\' then EditDest.Text := EditDest.Text + '\';
  154. end;
  155.  
  156. procedure TForm1.btnCancelClick(Sender: TObject);
  157. begin
  158.  CancelOp := True;
  159. end;
  160.  
  161. end.
  162.