对音频波表显示及音频均衡处理的技术性文章或源代码(300分)

  • 主题发起人 主题发起人 houling
  • 开始时间 开始时间
H

houling

Unregistered / Unconfirmed
GUEST, unregistred user!
[red][/red]对音频波表显示及音频均衡处理的技术性文件或代码,不要提供什么控件类的东西。
 
您能说得更清楚一些吗?
 
delphix最新版的控件中有很多这方面例子,可供参考[:)]
 
有知情者不?
 
PowerDesigner950.655.EBF2
 
我也想知道
 
unit USpectrumUtil;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
shellapi,SpectrumUtil,ExtCtrls, Buttons, StdCtrls;

type
TSpectrumForm = class(TForm)
SpectrumDisplay: TPaintBox;
Label1: TLabel;
MainPanel: TPanel;
PanelOK: TPanel;
SpeedBtnOK: TSpeedButton;
Panel2: TPanel;
SpeedButton2: TSpeedButton;
procedure SpectrumDisplayPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Label1Click(Sender: TObject);
procedure SpeedBtnOKClick(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
protected
procedure FFTDataReady(var msg: TMessage);
message MSG_DATARDY;

end;


var
SpectrumForm: TSpectrumForm;

implementation

{$R *.DFM}

const
Msg = '作者:刀剑如梦' +#13#10+
'联系:yckxzjj@163.com'+#13#10+
'主页:http://yckxzjj.vip.sina.com'+#13#10+
'注意:要显示频谱,先用播放器打开一个音乐文件! ' +#13#10;
var
AppEnabled: Boolean = False;
FFTData: TFFTData;
centerfreq,FFTMax ,FFTScale, FFTBandwidth,
RXFrequency, TXFrequency: Integer;

procedure TSpectrumForm.FFTDataReady(var Msg: TMessage);
begin

if AppEnabled then

begin

fnGetFFTData( @FFTData, 0, FFTMax );
RxFrequency := Msg.WParam;
SpectrumDisplayPaint(Self);
end;

end;


procedure TSpectrumForm.SpectrumDisplayPaint(Sender: TObject);
var
DisplayBitmap: TBitmap;
DisplayRect: TRect;
bmwidth, bmheight, i, fftrange: Integer;
begin

with SpectrumDisplaydo
begin

bmwidth := Width;
bmheight := Height;
DisplayBitmap := TBitmap.Create;
DisplayBitmap.Width := bmwidth;
DisplayBitmap.Height := bmheight;
DisplayRect.Left := 0;
DisplayRect.Top := 0;
DisplayRect.Right := bmwidth;
DisplayRect.Bottom := bmheight;
with DisplayBitmap.Canvasdo
begin

Brush.Color := clBlack;
FillRect(DisplayRect);
end;

if AppEnabled then

begin

with DisplayBitmap.Canvasdo

begin

Pen.Color := clRed ;
i := RxFrequency * bmwidth div FFTBandwidth;
MoveTo(i,0);
LineTo(i,bmheight-1);
// now draw spectrum display
Pen.Color := clAqua;
MoveTo(0, bmheight-1);
LineTo(0, bmheight-(FFTData[0]*bmheight) div FFTScale);
fftrange := FFTMax;
for i := 1 to bmwidthdo

begin

MoveTo(i, bmheight-1);
LineTo(i, bmheight-(FFTData[(i*fftrange div bmwidth)]*bmheight) div FFTScale);
end;

end;

end
else

with DisplayBitmapdo

begin

DisplayRect:=BoundsRect;
Canvas.Font.Color := clRed;
DrawText(Canvas.Handle, Msg, -1,DisplayRect , DT_WORDBREAK or DT_NOPREFIX or DT_VCENTER or DT_CENTER);
end;

BitBlt(Canvas.Handle, 0, 0, Width, Height, DisplayBitmap.Canvas.Handle, 0, 0, SRCCOPY);
DisplayBitmap.Free;
end;


end;


procedure TSpectrumForm.FormCreate(Sender: TObject);
begin

centerfreq:=1000;
RxFrequency := centerfreq;
TxFrequency := centerfreq;
FFTMax := centerfreq * 2048 div 4000 - 1;
if FFTMax > 1023 then
FFTMax := 1023;
FFTScale := 100;
FFTBandwidth := (FFTMax+1) * 8000 div 2048;
end;


procedure TSpectrumForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin

if AppEnabled then
fnStopSoundCard;
end;


procedure TSpectrumForm.Label1Click(Sender: TObject);
begin

ShellExecute(Handle,'Open',PChar('http://yckxzjj.vip.sina.com'),nil,nil,SW_SHOW);
end;


procedure TSpectrumForm.SpeedBtnOKClick(Sender: TObject);
begin

// SpeedBtnOK.Down := True;
//AppEnabled := SpeedBtnOK.Down;
AppEnabled := True;
if AppEnabled then
begin

if fnStartSoundCard(Handle,-1,1) = 0 then
begin

// 初始化动态库设置
fnSetFFTMode(1, FFTScale, 1);
fnSetRXPSKMode(0,0);
fnSetAFCLimit(Ord(False)*10,0);
fnSetSquelchThreshold(15,1,0);
fnSetRXFrequency(RxFrequency, 0, 0);
SpeedBtnOK.Font.Color := clRed;
end;

end
else

begin

fnStopSoundCard;
SpectrumDisplayPaint(Sender);
SpeedBtnOK.Font.Color := clWindowText;
end;

end;

procedure TSpectrumForm.SpeedButton2Click(Sender: TObject);
begin

Application.MessageBox(Pchar(Msg), '刀剑如梦软件创作室', MB_ICONINFORMATION);
end;


end.
 
//------------SpectrumUtil.pas-----------------------//

unit SpectrumUtil;

interface

uses Windows, Messages;

type
// Data types used by the DLL
TFFTData = array[0 .. 1023] of integer;
PFFTData = ^TFFTData;

TVectorData = array[0 .. 15] of integer;
PVectorData = ^TVectorData;

TPeakData = array[0 .. 4] of integer;
PPeakData = ^TPeakData;

TSyncData = array[0 .. 15] of integer;
PSyncData = ^TSyncData;

TRawData = array[0 .. 2047] of integer;
PRawData = ^TRawData;

const
DllFileName = 'Spectrum.dll';
// Windows messages sent by the DLL
MSG_DATARDY = WM_USER+1000; // Sent whenever FFT or raw data available from the soundcard
MSG_PSKCHARRDY = WM_USER+1001; // Sent whenever a character has been received or sent
MSG_STATUSCHANGE = WM_USER + 1002;
// Sent whenever a status change occurs in the DLL
MSG_IMDRDY = WM_USER + 1003; // Sent when an IMD reading has been calculated
MSG_CLKERR = WM_USER + 1004; // Sent when a sound card clock error has been calculated

// Function prototypes for the PSKCORE DLL
// =======================================
//
// Initialization / shutdown functions
//
function fnStartSoundCard(h_Wnd: hWnd;
cardnum, numRXchannels: integer): integer;
stdcall;
external DllFileName;
procedure fnStopSoundCard;
stdcall;
external DllFileName;
//
// Receive functions
//
procedure fnSetRXFrequency(freq, range, channel: integer);
stdcall;
external DllFileName;
procedure fnSetRXPSKMode(mode, chan: integer);
stdcall;
external DllFileName;
function fnGetRXFrequency(channel: integer): integer;
stdcall;
external DllFileName;
procedure fnSetFFTMode(ave, maxscale, mode: integer);
stdcall;
external DllFileName;
function fnGetFFTData(DataArray: PFFTData;
startpos, endpos: integer): boolean;
stdcall;
external DllFileName;
procedure fnGetFFTPeaks(PeakArray: PPeakData;
startpos, endpos : integer);
stdcall;
external DllFileName;
procedure fnGetSyncData(SyncArray: PSyncData;
channel: integer);
stdcall;
external DllFileName;
procedure fnGetVectorData(VectorArray: PVectorData;
channel: integer);
stdcall;
external DllFileName;
function fnGetRawData(DataArray: PRawData;
startpos, endpos: integer): integer;
stdcall;
external DllFileName;
procedure fnSetAFCLimit(limit, channel: integer);
stdcall;
external DllFileName;
procedure fnSetSquelchThreshold(thresh, mode, channel: integer);
stdcall;
external DllFileName;
function fnGetSignalLevel(channel: integer): integer;
stdcall;
external DllFileName;
//
// Transmit functions
//
procedure fnStartTX(mode: integer);
stdcall;
external DllFileName;
procedure fnStopTX;
stdcall;
external DllFileName;
procedure fnAbortTX;
stdcall;
external DllFileName;
procedure fnSetTXFrequency(freq: integer);
stdcall;
external DllFileName;
procedure fnSetCWIDString(lpszIDStrg: PChar);
stdcall;
external DllFileName;
function fnSendTXCharacter(txchar, cntrl: integer): integer;
stdcall;
external DllFileName;
procedure fnSendTXString(lpszTXStrg: PChar);
stdcall;
external DllFileName;
function fnGetTXCharsRemaining: integer;
stdcall;
external DllFileName;
procedure fnClearTXBuffer;
stdcall;
external DllFileName;
procedure fnSetCWIDSpeed(speed: integer);
stdcall;
external DllFileName;
function fnSetComPort(portnum, mode: integer): boolean;
stdcall;
external DllFileName;
//
// Miscellaneous functions
procedure fnSetClockErrorAdjustment(ppm: integer);
stdcall;
external DllFileName;
function fnGetDLLVersion: integer;
stdcall;
external DllFileName;

implementation

end.
 
完整示例源码下载:
[Delphi编程驿站]http://yckxzjj.vip.sina.com/developer/SpectrumDemo.rar
Delphi编程驿站欢迎您的到来,希望彼此间加强交流与探讨!
 
好像有问题呀.不管音乐是不是停了,波形还在“波”
另外,那波也太小了,难看
 
houling老兄,把播放wmv切换原/伴唱源代码或者方法告诉我好吗?
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部