Delphi中用多媒体库Bass.dll播放mp3 [11] - 使用回调函数设置反复

Delphi中用多媒体库Bass.dll播放mp3 [11] - 使用回调函数设置反复2011-12-12 万一本例效果图:
代码文件:
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; {流句柄}
  Data: array of Cardinal;
  bit: TBitmap;
  hSyncLoop: Cardinal; {回调函数句柄}
  Mp3Len: Cardinal;  {Mp3 总的字节长度}
procedure TForm1.FormCreate（Sender: TObject）;
begin
  Label1.Caption := "提示: 鼠标左键设置反复起始点（黄线）; 右键设置反复拐点（红线）.";
  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" 文件版本不合适！ ", nil, MB_ICONERROR）;
  if not BASS_Init（-1, 44100, 0, 0, nil） then ShowMessage（"初始化错误"）;
end;
{打开}
procedure TForm1.Button1Click（Sender: TObject）;
var
  Mp3Path: AnsiString;
  i: Cardinal;
  time: Double;
  hs2: HSTREAM;
begin
  BASS_StreamFree（hs）;
  OpenDialog1.Filter := "Mp3 文件（*.mp3）|*.mp3|Wav 文件（*.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 := "打开失败"
  else begin
   Text := string（Mp3Path）;
   bit.Free;
   bit := TBitmap.Create;
   PaintBox1.Repaint;
   {获取波形数据}
   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 总字节长度}
   Mp3Len := BASS_ChannelGetLength（hs, BASS_POS_BYTE）;
   {调用绘制过程}
   Draw;
  end;
end;
{播放}
procedure TForm1.Button2Click（Sender: TObject）;
begin
  Timer1.Enabled := True;
  BASS_ChannelPlay（hs, False）;
end;
{暂停}
procedure TForm1.Button3Click（Sender: TObject）;
begin
  Timer1.Enabled := False;
  BASS_ChannelPause（hs）;
end;
{从头播放}
procedure TForm1.Button4Click（Sender: TObject）;
begin
  Timer1.Enabled := True;
  BASS_ChannelPlay（hs, True）;
end;
{清除反复标记}
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;
{刷新}
procedure TForm1.PaintBox1Paint（Sender: TObject）;
begin
  PaintBox1.Canvas.StretchDraw（Bounds（0, 0, PaintBox1.Width, PaintBox1.Height）, bit）;
end;
{绘制波形图}
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;
{播放指针线}
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;
{鼠标左键设定反复起始点, 右键设定反复拐点}
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;
    
    {删除上次的回调句柄}
    BASS_ChannelRemoveSync（hs, hSyncLoop）;
    {指定反复点, 建立回调}
    PosLoop := Trunc（Shape3.Left / PaintBox1.Width * Mp3Len）;
    hSyncLoop := BASS_ChannelSetSync（hs, BASS_SYNC_POS, PosLoop, @MySyncLoop, nil）;
   end;
  end;
end;
{执行反复播放的回调函数}
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.