• 用多媒体库 Bass.dll 播放 mp3 [9] 绘制波形图


    本例效果图:



    代码文件:
    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
    
  • 相关阅读:
    P1265 公路修建 最小生成树
    P1991 无线通讯网 最小生成树
    Stock Chase 拓扑
    Rank of Tetris 拓扑排序+并查集
    P1169 [ZJOI2007]棋盘制作 DP悬线法
    P4147 玉蟾宫 二维DP 悬线法
    P1341 无序字母对 欧拉回路
    P2921 [USACO08DEC]在农场万圣节Trick or Treat on the Farm 记忆化搜索dfs
    BSTestRunner插件的用法.py
    Selenium
  • 原文地址:https://www.cnblogs.com/del/p/1271827.html
Copyright © 2020-2023  润新知