程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 在 Delphi 下使用 DirectSound (13): 測試回聲效果器 IDirectSoundFXEcho8

在 Delphi 下使用 DirectSound (13): 測試回聲效果器 IDirectSoundFXEcho8

編輯:Delphi

{相關結構:} 
TDSFXEcho = packed record 
  fWetDryMix: Single;  //0 .. 100  : 50 (%) 
  fFeedback: Single;  //0 .. 100  : 50 (%) 
  fLeftDelay: Single;  //1 .. 2000 : 500(ms) 
  fRightDelay: Single; //1 .. 2000 : 500(ms) 
  lPanDelay: Longint;  //0 .. 1    : 0  (False) 
end; 
 
//該結構相關常量: 
DSFXECHO_WETDRYMIX_MIN  = 0.0; 
DSFXECHO_WETDRYMIX_MAX  = 100.0; 
 
DSFXECHO_FEEDBACK_MIN  = 0.0; 
DSFXECHO_FEEDBACK_MAX  = 100.0; 
 
DSFXECHO_LEFTDELAY_MIN  = 1.0; 
DSFXECHO_LEFTDELAY_MAX  = 2000.0; 
 
DSFXECHO_RIGHTDELAY_MIN = 1.0; 
DSFXECHO_RIGHTDELAY_MAX = 2000.0; 
 
DSFXECHO_PANDELAY_MIN  = 0; //False 
DSFXECHO_PANDELAY_MAX  = 1; //True 

  測試代碼:

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, ExtCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    LabeledEdit1: TLabeledEdit; 
    LabeledEdit2: TLabeledEdit; 
    LabeledEdit3: TLabeledEdit; 
    LabeledEdit4: TLabeledEdit; 
    RadioGroup1: TRadioGroup; 
    procedure FormCreate(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure RadioGroup1Click(Sender: TObject); 
    procedure LabeledEdit1Change(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
uses DirectSound, ReadWave2; 
 
var 
  myDSound: IDirectSound8; 
  buf8: IDirectSoundBuffer8; 
  fxEcho: IDirectSoundFXEcho8; //IDirectSoundFXEcho8 效果器 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  System.ReportMemoryLeaksOnShutdown := True; 
  DirectSoundCreate8(nil, myDSound, nil); 
  myDSound.SetCoOperativeLevel(Handle, DSSCL_NORMAL); 
 
  Button1.Caption := '打開並播放'; 
  Button2.Caption := '停止播放'; 
 
  LabeledEdit1.EditLabel.Caption := 'fWetDryMix: 0.0 - 100.'; 
  LabeledEdit1.Text := '50.0'; 
  LabeledEdit1.Tag := 1; 
 
  LabeledEdit2.EditLabel.Caption := 'fFeedback: 0.0 - 100.0'; 
  LabeledEdit2.Text := '50.0'; 
  LabeledEdit2.Tag := 2; 
 
  LabeledEdit3.EditLabel.Caption := 'fLeftDelay: 1.0 - 2000.0'; 
  LabeledEdit3.Text := '500.0'; 
  LabeledEdit3.Tag := 3; 
 
  LabeledEdit4.EditLabel.Caption := 'fRightDelay: 1.0 - 2000.0'; 
  LabeledEdit4.Text := '500.0'; 
  LabeledEdit4.Tag := 4; 
 
  RadioGroup1.Caption := 'lPanDelay:'; 
  RadioGroup1.Items.CommaText := 'False, True'; 
  RadioGroup1.ItemIndex := 0; 
 
  LabeledEdit2.OnChange := LabeledEdit1.OnChange; 
  LabeledEdit3.OnChange := LabeledEdit1.OnChange; 
  LabeledEdit4.OnChange := LabeledEdit1.OnChange; 
end; 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  buf: IDirectSoundBuffer; 
  bufDesc: TDSBufferDesc; 
  rEffect: TDSEffectDesc; 
  wav: TReadWave; 
  p1: Pointer; 
  n1: DWord; 
begin 
  wav := TReadWave.Create; 
  if not wav.OpenDialog then begin wav.Free; Exit; end; 
 
  ZeroMemory(@bufDesc, SizeOf(TDSBufferDesc)); 
  bufDesc.dwSize := SizeOf(TDSBufferDesc); 
  bufDesc.dwFlags := DSBCAPS_CTRLFX; 
  bufDesc.dwBufferBytes := wav.Size; 
  bufDesc.lpwfxFormat := @wav.Format; 
  myDSound.CreateSoundBuffer(bufDesc, buf, nil); 
  buf.QueryInterface(IID_IDirectSoundBuffer8, buf8); 
 
  buf8.Lock(0, 0, @p1, @n1, nil, nil, DSBLOCK_ENTIREBUFFER); 
  wav.Read(p1, n1); 
  wav.Free; 
  buf8.Unlock(p1, n1, nil, 0); 
 
  ZeroMemory(@rEffect, SizeOf(TDSEffectDesc)); 
  rEffect.dwSize := SizeOf(TDSEffectDesc); 
  rEffect.dwFlags := 0; 
  rEffect.guidDSFXClass := GUID_DSFX_STANDARD_ECHO; 
  buf8.SetFX(1, @rEffect, nil); 
  buf8.GetObjectInPath(GUID_DSFX_STANDARD_ECHO, 0, IID_IDirectSoundFXEcho8, fxEcho); 
  buf8.Play(0, 0, DSBPLAY_LOOPING); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  if Assigned(buf8) then buf8.Stop; 
end; 
 
procedure TForm1.RadioGroup1Click(Sender: TObject); 
var 
  rEcho: TDSFXEcho; 
begin 
  if buf8 = nil then Exit; 
  rEcho.fWetDryMix := StrToFloat(LabeledEdit1.Text); 
  rEcho.fFeedback    := StrToFloat(LabeledEdit2.Text); 
  rEcho.fLeftDelay  := StrToFloat(LabeledEdit3.Text); 
  rEcho.fRightDelay := StrToFloat(LabeledEdit4.Text); 
  rEcho.lPanDelay  := RadioGroup1.ItemIndex; 
  fxEcho.SetAllParameters(rEcho); 
end; 
 
procedure TForm1.LabeledEdit1Change(Sender: TObject); 
var 
  f: Single; 
  obj: TLabeledEdit; 
begin 
  obj := Sender as TLabeledEdit; 
  //if obj.Text = '-' then Exit; 
  f := StrToFloatDef(obj.Text, MaxInt); 
  case obj.Tag of 
    1:  if (f < 0) or (f > 100)  then obj.Text := '50.0'; 
    2:  if (f < 0) or (f > 100)  then obj.Text := '50.0'; 
    3,4: if (f < 1) or (f > 2000) then obj.Text := '500.0'; 
  end; 
  RadioGroup1.OnClick(nil); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  buf8 := nil; 
  myDSound := nil; 
end; 
 
end. 

 窗體設計:

object Form1: TForm1 
  Left = 0 
  Top = 0 
  Caption = 'Form1' 
  ClIEntHeight = 194 
  ClIEntWidth = 326 
  Color = clBtnFace 
  Font.Charset = DEFAULT_CHARSET 
  Font.Color = clWindowText 
  Font.Height = -11 
  Font.Name = 'Tahoma' 
  Font.Style = [] 
  OldCreateOrder = False 
  OnCreate = FormCreate 
  OnDestroy = FormDestroy 
  PixelsPerInch = 96 
  TextHeight = 13 
  object Button1: TButton 
    Left = 32 
    Top = 22 
    Width = 75 
    Height = 25 
    Caption = 'Button1' 
    TabOrder = 0 
    OnClick = Button1Click 
  end 
  object Button2: TButton 
    Left = 32 
    Top = 53 
    Width = 75 
    Height = 25 
    Caption = 'Button2' 
    TabOrder = 1 
    OnClick = Button2Click 
  end 
  object LabeledEdit1: TLabeledEdit 
    Left = 168 
    Top = 24 
    Width = 138 
    Height = 21 
    EditLabel.Width = 61 
    EditLabel.Height = 13 
    EditLabel.Caption = 'LabeledEdit1' 
    TabOrder = 2 
    OnChange = LabeledEdit1Change 
  end 
  object LabeledEdit2: TLabeledEdit 
    Left = 168 
    Top = 67 
    Width = 138 
    Height = 21 
    EditLabel.Width = 61 
    EditLabel.Height = 13 
    EditLabel.Caption = 'LabeledEdit2' 
    TabOrder = 3 
  end 
  object LabeledEdit3: TLabeledEdit 
    Left = 168 
    Top = 112 
    Width = 138 
    Height = 21 
    EditLabel.Width = 61 
    EditLabel.Height = 13 
    EditLabel.Caption = 'LabeledEdit3' 
    TabOrder = 4 
  end 
  object LabeledEdit4: TLabeledEdit 
    Left = 168 
    Top = 160 
    Width = 138 
    Height = 21 
    EditLabel.Width = 61 
    EditLabel.Height = 13 
    EditLabel.Caption = 'LabeledEdit4' 
    TabOrder = 5 
  end 
  object RadioGroup1: TRadioGroup 
    Left = 16 
    Top = 104 
    Width = 129 
    Height = 77 
    Caption = 'RadioGroup1' 
    TabOrder = 6 
    OnClick = RadioGroup1Click 
  end 
end 

  運行效果圖:

在 Delphi 下使用 DirectSound (13): 測試回聲效果器 IDirectSoundFXEcho8



  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved