本例效果图:
代码文件:
代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls; type TForm1 = class(TForm) OpenDialog1: TOpenDialog; PaintBox1: TPaintBox; Button1: TButton; Button2: TButton; Button3: TButton; ColorBox1: TColorBox; ColorBox2: TColorBox; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure ColorBox1Change(Sender: TObject); procedure ColorBox2Change(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure PaintBox1Paint(Sender: TObject); private procedure Draw; end; var Form1: TForm1; implementation {$R *.dfm} uses Bass; var hs: HSTREAM; {流句柄} Data: array of Cardinal; bit: TBitmap; procedure TForm1.FormCreate(Sender: TObject); begin bit := TBitmap.Create; PaintBox1.Align := alTop; ColorBox1.Selected := clBlack; ColorBox2.Selected := clLime; 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_STREAM_DECODE, 这样可以提前读取波形数据} hs2 := BASS_StreamCreateFile(False, PAnsiChar(Mp3Path), 0, 0, BASS_STREAM_DECODE); {用 BASS_ChannelGetLevel 获取峰值时, 是以 20ms 为一个单位的; 先获取总时间} time := BASS_ChannelBytes2Seconds(hs2, BASS_ChannelGetLength(hs, BASS_POS_BYTE)); {time * 1000 div 20 + 1 是可以获取的总的峰值数据, 也是数组需要的大小} SetLength(Data, Trunc(time * 50 + 1)); {遍历峰值数据填充数组} for i := 0 to Length(Data) - 1 do Data[i] := BASS_ChannelGetLevel(hs2); {hs2 此时已完成使命, 释放它} BASS_StreamFree(hs2); {调用绘制过程} Draw; end; end; {播放} procedure TForm1.Button2Click(Sender: TObject); begin BASS_ChannelPlay(hs, False); end; {暂停} procedure TForm1.Button3Click(Sender: TObject); begin BASS_ChannelPause(hs); end; {背景色} procedure TForm1.ColorBox1Change(Sender: TObject); begin Draw; end; {前景色} procedure TForm1.ColorBox2Change(Sender: TObject); begin Draw; 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 := ColorBox1.Selected; bit.Canvas.FillRect(Bounds(0, 0, bit.Width, bit.Height)); bit.Canvas.Pen.Color := ColorBox2.Selected; 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; end.窗体文件:
object Form1: TForm1 Left = 222 Top = 114 Caption = 'Form1' ClientHeight = 173 ClientWidth = 504 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 = 40 Top = 0 Width = 105 Height = 131 OnPaint = PaintBox1Paint end object Button1: TButton Left = 8 Top = 137 Width = 75 Height = 25 Caption = #25171#24320 TabOrder = 0 OnClick = Button1Click end object Button2: TButton Left = 89 Top = 137 Width = 75 Height = 25 Caption = #25773#25918 TabOrder = 1 OnClick = Button2Click end object Button3: TButton Left = 170 Top = 137 Width = 75 Height = 25 Caption = #26242#20572 TabOrder = 2 OnClick = Button3Click end object ColorBox1: TColorBox Left = 315 Top = 139 Width = 85 Height = 22 ItemHeight = 16 TabOrder = 3 OnChange = ColorBox1Change end object ColorBox2: TColorBox Left = 406 Top = 139 Width = 90 Height = 22 ItemHeight = 16 TabOrder = 4 OnChange = ColorBox2Change end object OpenDialog1: TOpenDialog Left = 192 Top = 32 end end