// 在Delphi2009 下编译运行,能听见声音,在窗体退出时,保存地址访问错误。 估计是接口没有释放。但是 Delphi 应该会自动释放接口。还是接口引用计数的问题?请高手,看看。现在贴上代码:
unit Unit2;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MMSystem, DirectSound, StdCtrls,Activex;type
TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
lpDirectSound: IDirectSound;
lpDirectSoundBuffer: IDirectSoundBuffer;
public
{ Public declarations }
end;var
Form2: TForm2;
implementation{$R *.dfm}procedure TForm2.Button1Click(Sender: TObject);
var
audiobuf: array [0 .. 160000 - 1] of byte;
stream: TFileStream;
format: TWAVEFORMATEX;
BufferDesc: DSBUFFERDESC;
ptr1, ptr2: pointer;
pdw1, pdw2: dword;
begin // DemoTest.wav 替换自己的 随便找一个。
stream := TFileStream.Create(extractfilepath(ParamStr(0))+'DemoTest.wav', fmOpenRead);
stream.ReadBuffer(audiobuf, stream.Size); fillchar(format, sizeof(format), 0);
format.wFormatTag := WAVE_FORMAT_PCM;
format.nChannels := 1;
format.nSamplesPerSec := 8000;
format.nAvgBytesPerSec := 16000;
format.nBlockAlign := 2;
format.wBitsPerSample := 16; fillchar(BufferDesc, sizeof(BufferDesc), 0);
BufferDesc.dwSize := sizeof(BufferDesc);
BufferDesc.dwBufferBytes := stream.Size;
BufferDesc.lpwfxFormat := @format;
DirectSoundCreate(nil, lpDirectSound, nil);
lpDirectSound.SetCooperativeLevel(Handle, DSSCL_NORMAL);
lpDirectSound.CreateSoundBuffer(BufferDesc, lpDirectSoundBuffer, nil);
lpDirectSoundBuffer.Lock(0, stream.Size, @ptr1, @pdw1, @ptr2, @pdw2, 0);
copymemory(ptr1, @audiobuf, pdw1);
copymemory(ptr2, pchar(@audiobuf) + pdw1, pdw2);
lpDirectSoundBuffer.Unlock(ptr1, pdw1, ptr2, pdw2);
lpDirectSoundBuffer.Play(0, 0, 0);
stream.Free;
end;procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
end;end.// 窗体文件
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 202
ClientWidth = 447
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 160
Top = 80
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 304
Top = 80
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 1
end
end
unit Unit2;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MMSystem, DirectSound, StdCtrls,Activex;type
TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
lpDirectSound: IDirectSound;
lpDirectSoundBuffer: IDirectSoundBuffer;
public
{ Public declarations }
end;var
Form2: TForm2;
implementation{$R *.dfm}procedure TForm2.Button1Click(Sender: TObject);
var
audiobuf: array [0 .. 160000 - 1] of byte;
stream: TFileStream;
format: TWAVEFORMATEX;
BufferDesc: DSBUFFERDESC;
ptr1, ptr2: pointer;
pdw1, pdw2: dword;
begin // DemoTest.wav 替换自己的 随便找一个。
stream := TFileStream.Create(extractfilepath(ParamStr(0))+'DemoTest.wav', fmOpenRead);
stream.ReadBuffer(audiobuf, stream.Size); fillchar(format, sizeof(format), 0);
format.wFormatTag := WAVE_FORMAT_PCM;
format.nChannels := 1;
format.nSamplesPerSec := 8000;
format.nAvgBytesPerSec := 16000;
format.nBlockAlign := 2;
format.wBitsPerSample := 16; fillchar(BufferDesc, sizeof(BufferDesc), 0);
BufferDesc.dwSize := sizeof(BufferDesc);
BufferDesc.dwBufferBytes := stream.Size;
BufferDesc.lpwfxFormat := @format;
DirectSoundCreate(nil, lpDirectSound, nil);
lpDirectSound.SetCooperativeLevel(Handle, DSSCL_NORMAL);
lpDirectSound.CreateSoundBuffer(BufferDesc, lpDirectSoundBuffer, nil);
lpDirectSoundBuffer.Lock(0, stream.Size, @ptr1, @pdw1, @ptr2, @pdw2, 0);
copymemory(ptr1, @audiobuf, pdw1);
copymemory(ptr2, pchar(@audiobuf) + pdw1, pdw2);
lpDirectSoundBuffer.Unlock(ptr1, pdw1, ptr2, pdw2);
lpDirectSoundBuffer.Play(0, 0, 0);
stream.Free;
end;procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
end;end.// 窗体文件
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 202
ClientWidth = 447
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 160
Top = 80
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 304
Top = 80
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 1
end
end
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货