Delphi with Multimedia library Bass.dll play MP3 [11]

This example effect chart:

Code files:Unit Unit1;
Interface
Uses
Windows, Messages, sysutils, variants, Classes, Graphics, Controls, Forms,
Dialogs, Stdctrls, Extctrls, Comctrls, Bass;
Type
TForm1 = Class (Tform)
Opendialog1:topendialog;
Timer1:ttimer;
Paintbox1:tpaintbox;
Button1:tbutton;
Button2:tbutton;
Button3:tbutton;
Button4:tbutton;
Button5:tbutton;
Shape1:tshape;
Shape2:tshape;
Shape3:tshape;
Label1:tlabel;
Procedure Formcreate (Sender:tobject);
Procedure Button1Click (Sender:tobject);
Procedure Button2click (Sender:tobject);
Procedure Button3click (Sender:tobject);
Procedure Formdestroy (Sender:tobject);
Procedure Paintbox1paint (Sender:tobject);
Procedure Timer1timer (Sender:tobject);
Procedure Paintbox1mousedown (Sender:tobject; Button:tmousebutton;
Shift:tshiftstate; X, Y:integer);
Procedure Button4click (Sender:tobject);
Procedure Button5click (Sender:tobject);
Private
Procedure Draw;
End
Procedure Mysyncloop (Handle:hsync; channel, data, User:dword); stdcall;
Var
Form1:tform1;
Implementation
{$R *.DFM}
Uses Bass;
Var
Hs:hstream; {Stream Handle}
Data:array of Cardinal;
Bit:tbitmap;
hsyncloop:cardinal; {callback function handle}
mp3len:cardinal; {MP3 total byte length}
Procedure Tform1.formcreate (Sender:tobject);
Begin
Label1.Caption: = ' Hint: The left mouse button set repeated starting point (yellow Line); Right-click to set repeated inflection point (red line).
timer1.enabled: = False;
Timer1.interval: = 100;
Shape1.Pen.Style: = Psclear;
Shape1.Brush.Color: = Clwhite;
Shape1.width: = 3;
Shape1.height: = Paintbox1.height;
Shape1.top: = 0;
Shape1.left: =-1;
Shape2.Pen.Style: = Psclear;
Shape2.Brush.Color: = Clyellow;
Shape2.width: = 3;
Shape2.height: = Paintbox1.height;
Shape2.top: = 0;
Shape2.visible: = False;
Shape3.Pen.Style: = Psclear;
Shape3.Brush.Color: = clred;
Shape3.width: = 3;
Shape3.height: = Paintbox1.height;
Shape3.top: = 0;
Shape3.visible: = False;
bit: = Tbitmap.create;
Paintbox1.align: = Altop;
If HiWord (bass_getversion) <> Bassversion Then
MessageBox (0, "Bass.dll" file version is not suitable!) ', nil, mb_iconerror);
If not Bass_init ( -1, 44100, 0, 0, nil) then ShowMessage (' initialization error ');
End
Open
Procedure Tform1.button1click (Sender:tobject);
Var
mp3path:ansistring;
i:cardinal;
time:double;
Hs2:hstream;
Begin
Bass_streamfree (HS);
Opendialog1.filter: = ' Mp3 file (*.mp3) |*.mp3| Wav file (*.wav) |*wav ';
If Opendialog1.execute Then
Mp3path: = ansistring (Opendialog1.filename);
HS: = Bass_streamcreatefile (False, Pansichar (Mp3path), 0, 0, 0);
If HS < bass_error_ended Then
Text: = ' Open failed '
ELSE begin
Text: = string (Mp3path);
Bit. Free;
bit: = Tbitmap.create;
Paintbox1.repaint;
{Get Waveform data}
HS2: = Bass_streamcreatefile (False, Pansichar (Mp3path), 0, 0, Bass_stream_decode);
Time: = Bass_channelbytes2seconds (HS2, Bass_channelgetlength (HS, bass_pos_byte));
SetLength (Data, Trunc (Time * 50 + 1));
For I: = 0 to Length (Data)-1 do data[i]: = Bass_channelgetlevel (HS2);
Bass_streamfree (HS2);
{MP3 total byte length}
Mp3len: = Bass_channelgetlength (HS, Bass_pos_byte);
{Call Drawing process}
Draw;
End
End
Play
Procedure Tform1.button2click (Sender:tobject);
Begin
timer1.enabled: = True;
Bass_channelplay (HS, False);
End
Suspended
Procedure Tform1.button3click (Sender:tobject);
Begin
timer1.enabled: = False;
Bass_channelpause (HS);
End
{Play from the beginning}
Procedure Tform1.button4click (Sender:tobject);
Begin
timer1.enabled: = True;
Bass_channelplay (HS, True);
End
{Clear repeated tags}
Procedure Tform1.button5click (Sender:tobject);
Begin
Shape2.visible: = False;
Shape3.visible: = False;
Bass_channelremovesync (HS, Hsyncloop);
End
Procedure Tform1.formdestroy (Sender:tobject);
Begin
Bass_free;
Bit. Free;
End
Refresh
Procedure Tform1.paintbox1paint (Sender:tobject);
Begin
PaintBox1.Canvas.StretchDraw (Bounds (0, 0, Paintbox1.width, paintbox1.height), bit);
End
{Draw Wave Diagram}
Procedure Tform1.draw;
Var
I,ch:integer;
L,r:smallint;
Begin
Bit. Width: = Length (Data);
Bit. Height: = Paintbox1.height;
CH: = bit. Height Div 2;
Bit. Canvas.Brush.Color: = Clblack;
Bit. Canvas.fillrect (Bounds (0, 0, bit). Width, bit. Height));
Bit. Canvas.Pen.Color: = Cllime;
For I: = 0 to Length (Data)-1 do
Begin
L: = LoWord (Data[i]);
R: = HiWord (Data[i]);
Bit. Canvas.moveto (i, Ch-trunc (l/32768*ch));
Bit. Canvas.lineto (i, CH + Trunc (r/32768*ch));
End
Paintbox1.repaint;
End
{Play Pointer line}
Procedure Tform1.timer1timer (Sender:tobject);
Begin
If Bass_channelisactive (HS) = Bass_active_playing Then
Shape1.left: = Trunc (Bass_channelgetposition (HS, Bass_pos_byte)/Mp3len * paintbox1.width);
End
{The left mouse button set repeated starting point, right key set repeated inflection points}
Procedure Tform1.paintbox1mousedown (Sender:tobject; Button:tmousebutton;
Shift:tshiftstate; X, Y:integer);
Var
posloop:cardinal;
Begin
Case Button of
Mbleft:begin
Shape2.left: = X;
Shape2.visible: = True;
End
Mbright:begin
Shape3.left: = X;
Shape3.visible: = True;
　　　
{Delete last callback handle}
Bass_channelremovesync (HS, Hsyncloop);
{Specify recurrence point, create callback}
Posloop: = Trunc (Shape3.left/paintbox1.width * mp3len);
Hsyncloop: = Bass_channelsetsync (HS, Bass_sync_pos, Posloop, @MySyncLoop, nil);
End
End
End
{Perform a recurring callback function}
Procedure Mysyncloop (Handle:hsync; channel, data, User:dword); stdcall;
Var
posstart:cardinal;
Begin
If not Form1.Shape2.Visible then
Posstart: = 0
Else
Posstart: = Trunc (Form1.shape2.left/form1.paintbox1.width * mp3len);
Bass_channelpause (HS);
Bass_channelsetposition (HS, Posstart, bass_pos_byte);
Bass_channelplay (HS, False);
End
End.