用多媒體庫 Bass.dll 播放 mp3 [12] – 繪製動態頻譜 FFT

來源:互聯網
上載者:User
本例:


代碼檔案:
unit Unit1;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, ExtCtrls, ComCtrls;type  TForm1 = class(TForm)    OpenDialog1: TOpenDialog;    Timer1: TTimer;    PaintBox1: TPaintBox;    Button1: TButton;    Button2: TButton;    Button3: TButton;    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);  end;var  Form1: TForm1;implementation{$R *.dfm}uses Bass;var  hs: HSTREAM;  {流控制代碼}  FFTData: array[0..512] of Single;  bit: TBitmap;  FFTPeacks  : array [0..128] of Integer;  FFTFallOff : array [0..128] of Integer;procedure TForm1.FormCreate(Sender: TObject);begin  Timer1.Enabled := False;  Timer1.Interval := 30;  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;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_ACTIVE_PLAYING then Exit;  BASS_ChannelGetData(hs, @FFTData, BASS_DATA_FFT1024);  bit.Width := PaintBox1.Width;  bit.Height := PaintBox1.Height;  bit.Canvas.Brush.Color := clBlack;  bit.Canvas.FillRect(Rect(0, 0, bit.Width, bit.Height));  bit.Canvas.Pen.Color := clLime;  for i := 0 to Length(FFTData) - 1 do  begin    di := Trunc(Abs(FFTData[i]) * 500);    if di > bit.Height then di := bit.Height;    if di >= FFTPeacks[i] then FFTPeacks[i] := di else FFTPeacks[i] := FFTPeacks[i] - 1;    if di >= FFTFallOff[i] then FFTFallOff[i] := di else FFTFallOff[i] := FFTFallOff[i] - 3;    if (bit.Height - FFTPeacks[i]) > bit.Height then FFTPeacks[i] := 0;    if (bit.Height - FFTFallOff[i]) > bit.Height then FFTFallOff[i] := 0;//    bit.Canvas.MoveTo(i, bit.Height);//    bit.Canvas.LineTo(i, bit.Height - FFTFallOff[i]);//    bit.Canvas.Pixels[i, bit.Height - FFTPeacks[i]] := bit.Canvas.Pen.Color;    bit.Canvas.Pen.Color := bit.Canvas.Pen.Color;    bit.Canvas.MoveTo(i * (w + 1), bit.Height - FFTPeacks[i]);    bit.Canvas.LineTo(i * (w + 1) + w, bit.Height - FFTPeacks[i]);    bit.Canvas.Pen.Color := bit.Canvas.Pen.Color;    bit.Canvas.Brush.Color := bit.Canvas.Pen.Color;    bit.Canvas.Rectangle(i * (w + 1), bit.Height - FFTFallOff[i], i * (w + 1) + w, bit.Height);  end;  BitBlt(PaintBox1.Canvas.Handle, 0, 0, PaintBox1.Width, PaintBox1.Height, bit.Canvas.Handle, 0, 0, SRCCOPY);end;end.

表單檔案:

object Form1: TForm1  Left = 222  Top = 114  Caption = 'Form1'  ClientHeight = 154  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    OnPaint = PaintBox1Paint  end  object Button1: TButton    Left = 109    Top = 117    Width = 75    Height = 25    Caption = #25171#24320    TabOrder = 0    OnClick = Button1Click  end  object Button2: TButton    Left = 206    Top = 117    Width = 75    Height = 25    Caption = #25773#25918    TabOrder = 1    OnClick = Button2Click  end  object Button3: TButton    Left = 303    Top = 117    Width = 75    Height = 25    Caption = #26242#20572    TabOrder = 2    OnClick = Button3Click  end  object OpenDialog1: TOpenDialog    Left = 128    Top = 24  end  object Timer1: TTimer    OnTimer = Timer1Timer    Left = 128    Top = 72  endend
相關文章

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.