unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Forms,
Dialogs, StdCtrls, Controls, ExtCtrls, ComCtrls,
sTabControl, sLabel, sEdit, sComboBox, sButton, BASS, DB, ADODB;
type
TForm3 = class(TForm)
sTabControl1: TsTabControl;
sLabel1: TsLabel;
LAlbum: TsLabel;
EID: TsEdit;
LArtist: TsLabel;
ETitle: TsEdit;
LComment: TsLabel;
EArtist: TsEdit;
LComposer: TsLabel;
EAlbum: TsEdit;
LDuration: TsLabel;
EYear: TsEdit;
LFileSize: TsLabel;
EComment: TsEdit;
LGenre: TsLabel;
EGenre: TsComboBox;
LFileName: TsLabel;
EFileName: TsEdit;
Timer1: TTimer;
PB: TPaintBox;
Timer2: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure DrawSpectrum;
function PlayFile: boolean;
procedure ScanPeaks2(decoder: HSTREAM);
procedure PBPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
public
{ Public declarations }
end;
type TScanThread = class(TThread)
private
Fdecoder : HSTREAM;
protected
procedure Execute; override;
public
constructor Create(decoder:HSTREAM);
end;
type
TID3Tag = record
ID: string[3];
Titel: string[30];
Artist: string[30];
Album: string[30];
Year: string[4];
Comment: string[30];
Genre: Byte;
end;
const
Genres : array[0..146] of string =
('Blues','Classic Rock','Country','Dance','Disco','Funk','Grunge',
'Hip- Hop','Jazz','Metal','New Age','Oldies','Other','Pop','R&B',
'Rap','Reggae','Rock','Techno','Industrial','Alternative','Ska',
'Death Metal','Pranks','Soundtrack','Euro-Techno','Ambient',
'Trip-Hop','Vocal','Jazz+Funk','Fusion','Trance','Classical',
'Instrumental','Acid','House','Game','Sound Clip','Gospel','Noise',
'Alternative Rock','Bass','Punk','Space','Meditative','Instrumental Pop',
'Instrumental Rock','Ethnic','Gothic','Darkwave','Techno-Industrial','Electronic',
'Pop-Folk','Eurodance','Dream','Southern Rock','Comedy','Cult','Gangsta',
'Top 40','Christian Rap','Pop/Funk','Jungle','Native US','Cabaret','New Wave',
'Psychadelic','Rave','Showtunes','Trailer','Lo-Fi','Tribal','Acid Punk',
'Acid Jazz','Polka','Retro','Musical','Rock & Roll','Hard Rock','Folk',
'Folk-Rock','National Folk','Swing','Fast Fusion','Bebob','Latin','Revival',
'Celtic','Bluegrass','Avantgarde','Gothic Rock','Progressive Rock',
'Psychedelic Rock','Symphonic Rock','Slow Rock','Big Band','Chorus',
'Easy Listening','Acoustic','Humour','Speech','Chanson','Opera',
'Chamber Music','Sonata','Symphony','Booty Bass','Primus','Porn Groove',
'Satire','Slow Jam','Club','Tango','Samba','Folklore','Ballad',
'Power Ballad','Rhytmic Soul','Freestyle','Duet','Punk Rock','Drum Solo',
'Acapella','Euro-House','Dance Hall','Goa','Drum & Bass','Club-House',
'Hardcore','Terror','Indie','BritPop','Negerpunk','Polsk Punk','Beat',
'Christian Gangsta','Heavy Metal','Black Metal','Crossover','Contemporary C',
'Christian Rock','Merengue','Salsa','Thrash Metal','Anime','JPop','SynthPop');
var
Form3: TForm3;
Buffer: TBitmap;
wavebufL : array of smallint;
wavebufR : array of smallint;
loop : array[0..1] of DWORD;
chan : HSTREAM; // sample stream handle
chan2: HSTREAM;
bpp : dword; // stream bytes per pixel
killscan : boolean;
implementation
uses Unit1;
{$R *.dfm}
function readID3Tag(FileName: string): TID3Tag;
var
FS: TFileStream;
Buffer: array [1..128] of Char;
begin
FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
FS.Seek(-128, soFromEnd);
FS.Read(Buffer, 128);
with Result do
begin
ID := Copy(Buffer, 1, 3);
Titel := Copy(Buffer, 4, 30);
Artist := Copy(Buffer, 34, 30);
Album := Copy(Buffer, 64, 30);
Year := Copy(Buffer, 94, 4);
Comment := Copy(Buffer, 98, 30);
end;
finally
FS.Free;
end;
end;
procedure TForm3.Timer1Timer(Sender: TObject);
begin
if EFileName.Text <> '' then
begin
with readID3Tag(EFileName.Text) do
begin
EID.Text := ID;
ETitle.Text := Titel;
EArtist.Text := Artist;
EAlbum.Text := Album;
EYear.Text := Year;
EComment.Text := Comment;
if (Genre >= 0) and (Genre <=146) then
EGenre.Text := Genres[Genre]
else
EGenre.Text := 'N/A';
end;
end;
end;
procedure TForm3.Timer2Timer(Sender: TObject);
begin
DrawSpectrum; // draw peak waveform
PB.Refresh;
end;
procedure TForm3.DrawSpectrum;
var
i,ht : integer;
begin
//clear background
Buffer.Canvas.Brush.Color := clBlack;
Buffer.Canvas.FillRect(Rect(0,0,Buffer.Width,Buffer.Height));
//draw peaks
ht := ClientHeight div 2;
for i:=0 to length(wavebufL)-1 do
begin
Buffer.Canvas.MoveTo(i,ht);
Buffer.Canvas.Pen.Color := clLime;
Buffer.Canvas.LineTo(i,ht-trunc((wavebufL[i]/32768)*ht));
Buffer.Canvas.Pen.Color := clLime;
Buffer.Canvas.MoveTo(i,ht+2);
Buffer.Canvas.LineTo(i,ht+2+trunc((wavebufR[i]/32768)*ht));
end;
end;
function TForm3.PlayFile : boolean;
var
filename : string;
data : array[0..2000] of SmallInt;
i : integer;
begin
result := false;
if EFileName.Text <> '' then
begin
filename := EFileName.Text;
BringWindowToTop(Form3.Handle);
SetForegroundWindow(Form3.Handle);
//creating stream
chan := BASS_StreamCreateFile(FALSE,pchar(filename),0,0,0);
if chan = 0 then
begin
chan := BASS_MusicLoad(False, pchar(filename), 0, 0, BASS_MUSIC_RAMPS or BASS_MUSIC_POSRESET or BASS_MUSIC_PRESCAN, 0);
if (chan = 0) then
begin
ShowMessage('Can''t play file');
Exit;
end;
end;
//playing stream and setting global vars
for i:=0 to length(data)-1 do data[0] := 0;
bpp := BASS_ChannelGetLength(chan,BASS_POS_BYTE) div ClientWidth; // stream bytes per pixel
//getting peak levels in seperate thread, stream handle as parameter
chan2 := BASS_StreamCreateFile(FALSE,pchar(filename),0,0,BASS_STREAM_DECODE);
if (chan2 = 0) then chan2 := BASS_MusicLoad(FALSE,pchar(filename),0,0,BASS_MUSIC_DECODE,0);
TScanThread.Create(chan2); // start scanning peaks in a new thread
result := true;
end;
end;
procedure TForm3.ScanPeaks2(decoder : HSTREAM);
var
cpos,level : DWord;
peak : array[0..1] of DWORD;
position : DWORD;
counter : integer;
begin
cpos := 0;
peak[0] := 0;
peak[1] := 0;
counter := 0;
while not killscan do
begin
level := BASS_ChannelGetLevel(decoder); // scan peaks
if (peak[0]<LOWORD(level)) then
peak[0]:=LOWORD(level); // set left peak
if (peak[1]<HIWORD(level)) then
peak[1]:=HIWORD(level); // set right peak
if BASS_ChannelIsActive(decoder) <> BASS_ACTIVE_PLAYING then
begin
position := cardinal(-1); // reached the end
end else
position := BASS_ChannelGetPosition(decoder,BASS_POS_BYTE) div bpp;
if position > cpos then
begin
inc(counter);
if counter <= length(wavebufL)-1 then
begin
wavebufL[counter] := peak[0];
wavebufR[counter] := peak[1];
end;
if (position >= dword(ClientWidth)) then
break;
cpos := position;
end;
peak[0] := 0;
peak[1] := 0;
end;
BASS_StreamFree(decoder); // free the decoder
end;
constructor TScanThread.Create(decoder: HSTREAM);
begin
inherited create(false);
Priority := tpNormal;
FreeOnTerminate := true;
FDecoder := decoder;
end;
procedure TScanThread.Execute;
begin
inherited;
Form3.ScanPeaks2(FDecoder);
Terminate;
end;
procedure TForm3.PBPaint(Sender: TObject);
begin
if bpp = 0 then exit;
PB.Canvas.Draw(0,0,Buffer);
end;
procedure TForm3.FormCreate(Sender: TObject);
begin
Buffer := TBitmap.Create;
Buffer.Width:= PB.Width;
Buffer.Height:= PB.Height;
PB.Parent.DoubleBuffered := true;
//set array size
setlength(wavebufL,ClientWidth);
setlength(wavebufR,ClientWidth);
//init vars
loop[0] := 0;
loop[1] := 0;
//init BASS
if not BASS_Init(-1,44100,0,Application.Handle,nil) then
ShowMessage('Can''t initialize device');
//init timer for updating
Timer2.Interval := 20; //ms
Timer2.Enabled := true;
//main start play function
if not PlayFile then
begin
BASS_Free();
end;
end;
procedure TForm3.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Timer2.Enabled := false;
bpp := 0;
killscan := true;
Buffer.Free;
BASS_Free();
end;
end.
13.01.2014, 13:37
DrawSpectrum не отображается
Линейный вид
