![](https://www.cnblogs.com/images/cnblogs_com/del/148408/o_88213.gif)
代码文件:
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.窗体文件:
object Form1: TForm1 Left = 222 Top = 114 Caption = 'Form1' ClientHeight = 177 ClientWidth = 476 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poDesigned OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object PaintBox1: TPaintBox Left = 16 Top = 0 Width = 105 Height = 105 OnMouseDown = PaintBox1MouseDown OnPaint = PaintBox1Paint end object Shape1: TShape Left = 170 Top = 24 Width = 65 Height = 65 end object Shape2: TShape Left = 241 Top = 24 Width = 65 Height = 65 end object Shape3: TShape Left = 312 Top = 24 Width = 65 Height = 65 end object Label1: TLabel Left = 11 Top = 156 Width = 31 Height = 13 Caption = 'Label1' end object Button1: TButton Left = 8 Top = 120 Width = 75 Height = 25 Caption = #25171#24320 TabOrder = 0 OnClick = Button1Click end object Button2: TButton Left = 89 Top = 120 Width = 75 Height = 25 Caption = #25773#25918 TabOrder = 1 OnClick = Button2Click end object Button3: TButton Left = 170 Top = 120 Width = 75 Height = 25 Caption = #26242#20572 TabOrder = 2 OnClick = Button3Click end object Button4: TButton Left = 251 Top = 120 Width = 75 Height = 25 Caption = #20174#22836#25773#25918 TabOrder = 3 OnClick = Button4Click end object Button5: TButton Left = 375 Top = 120 Width = 93 Height = 25 Caption = #28165#38500#21453#22797#26631#35760 TabOrder = 4 OnClick = Button5Click end object OpenDialog1: TOpenDialog Left = 128 Top = 24 end object Timer1: TTimer OnTimer = Timer1Timer Left = 128 Top = 72 end end