這兩個參數也都是可以 Get(waveOutGetPlaybackRate、waveOutGetPitch)
設備默認的播放速度是 $00010000, 此值乘以 2 是快一倍, 除以 2 是慢一倍; 最快可到 $000F8000.
設備默認的音高參數是 $00010000, 此值乘以 2 是高一倍, 除以 2 是低一倍; 最高可到 $000F8000.
可能有很多聲卡不支持, 我的 IBM 手提就不支持; 不過通過其他技術可以實現的.
代碼文件(僅有播放速度的設置代碼):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
TrackBar1: TTrackBar;
Button5: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses MMSystem;
function GetWaveFmtData(path: string; var fmt: TWaveFormatEx; var buf: TBytes): Boolean;
var
hFile: HMMIO;
ckiRIFF,ckiFmt,ckiData: TMMCKInfo;
begin
Result := False;
hFile := mmioOpen(PChar(path), nil, MMIO_READ);
if hFile = 0 then Exit;
ZeroMemory(@ckiRIFF, SizeOf(TMMCKInfo));
ZeroMemory(@ckiFmt, SizeOf(TMMCKInfo));
ZeroMemory(@ckiData, SizeOf(TMMCKInfo));
ckiRIFF.fccType := mmiOStringToFOURCC('WAVE', 0);
ckiFmt.ckid := mmiOStringToFOURCC('fmt', 0);
ckiData.ckid := mmiOStringToFOURCC('data', 0);
ZeroMemory(@fmt, SizeOf(TWaveFormatEx));
mmioDescend(hFile, @ckiRIFF, nil, MMIO_FINDRIFF);
if (ckiRIFF.ckid = FOURCC_RIFF) and (ckiRIFF.fccType = mmiOStringToFOURCC('WAVE',0)) and
(mmioDescend(hFile, @ckiFmt, @ckiRIFF, MMIO_FINDCHUNK) = MMSYSERR_NOERROR) and
(mmioRead(hFile, @fmt, ckiFmt.cksize) = ckiFmt.cksize) and
(mmioAscend(hFile, @ckiFmt, 0) = MMSYSERR_NOERROR) and
(mmioDescend(hFile, @ckiData, @ckiRIFF, MMIO_FINDCHUNK) = MMSYSERR_NOERROR) then
begin
SetLength(buf, ckiData.cksize);
Result := (mmioRead(hFile, PAnsiChar(buf), ckiData.cksize) = ckiData.cksize);
end;
mmioClose(hFile, 0);
end;
//------------------------------------------------------------------------------
var
wh: TWaveHdr;
hWaveOut: HWAVE;
fmt: TWaveFormatEx;
buf: TBytes;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption := '打開並播放';
Button2.Caption := '暫停';
Button3.Caption := '繼續';
TrackBar1.Min := -4;
TrackBar1.Max := 4;
TrackBar1.Position := 0;
end;
procedure WaveProc(hWave: HWAVE; uMsg, dwInstance, dwParam1, dwParam2: DWord); stdcall;
begin
case uMsg of
MM_WOM_DONE: waveOutUnprepareHeader(hWave, PWaveHdr(dwParam1), SizeOf(TWaveHdr));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
path = 'C:\WINDOWS\Media\Windows XP 啟動.wav';
var
volume: DWord;
begin
GetWaveFmtData(path, fmt, buf);
wh.lpData := PAnsiChar(buf);
wh.dwBufferLength := Length(buf);
wh.dwBytesRecorded := 0;
wh.dwUser := 0;
wh.dwFlags := WHDR_BEGINLOOP or WHDR_ENDLOOP;
wh.dwLoops := 3;
wh.lpNext := nil;
wh.reserved := 0;
waveOutOpen(@hWaveOut, WAVE_MAPPER, @fmt, DWord(@WaveProc), 0, CALLBACK_FUNCTION);
waveOutPrepareHeader(hWaveOut, @wh, SizeOf(TWaveHdr));
waveOutWrite(hWaveOut, @wh, SizeOf(TWaveHdr));
end;
//暫停
procedure TForm1.Button2Click(Sender: TObject);
begin
waveOutPause(hWaveOut);
end;
//繼續
procedure TForm1.Button3Click(Sender: TObject);
begin
waveOutRestart(hWaveOut);
end;
//調整播放速度
procedure TForm1.TrackBar1Change(Sender: TObject);
const
mid = $00010000;
var
pos, rate: Integer;
begin
pos := TTrackBar(Sender).Position;
if pos > 0 then
rate := mid shl pos
else
rate := mid shr Abs(pos);
waveOutSetPlaybackRate(hWaveOut, rate);
Text := IntToStr(pos);
end;
//判斷設備是否支持播放速度調整
procedure TForm1.Button4Click(Sender: TObject);
var
waveOutCaps: TWaveOutCaps;
begin
waveOutGetDevCaps(WAVE_MAPPER, @waveOutCaps, SizeOf(TWaveOutCaps));
if waveOutCaps.dwSupport and WAVECAPS_PLAYBACKRATE = WAVECAPS_PLAYBACKRATE then
ShowMessage('默認設備支持播放速度調整.')
else
ShowMessage('默認設備不支持播放速度調整!');
end;
//判斷設備是否支持聲調變化
procedure TForm1.Button5Click(Sender: TObject);
var
waveOutCaps: TWaveOutCaps;
begin
waveOutGetDevCaps(WAVE_MAPPER, @waveOutCaps, SizeOf(TWaveOutCaps));
if waveOutCaps.dwSupport and WAVECAPS_PITCH = WAVECAPS_PITCH then
ShowMessage('默認設備支持聲調變化.')
else
ShowMessage('默認設備不支持聲調變化!');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if hWaveOut <> 0 then waveOutClose(hWaveOut);
end;
end.
窗體文件:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClIEntHeight = 204
ClIEntWidth = 342
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 = 24
Width = 75
Height = 25
Caption = #25171#24320#24182#25773#25918
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 136
Top = 24
Width = 75
Height = 25
Caption = #26242#20572
TabOrder = 1
OnClick = Button2Click
end
object Button3: TButton
Left = 240
Top = 24
Width = 75
Height = 25
Caption = #32487#32493
TabOrder = 2
OnClick = Button3Click
end
object TrackBar1: TTrackBar
Left = 32
Top = 88
Width = 283
Height = 45
TabOrder = 3
OnChange = TrackBar1Change
end
object Button4: TButton
Left = 152
Top = 139
Width = 163
Height = 25
Caption = #21028#26029#35774#22791#26159#21542#25903#25345#36895#24230#35843#25972
TabOrder = 4
OnClick = Button4Click
end
object Button5: TButton
Left = 152
Top = 170
Width = 163
Height = 25
Caption = #21028#26029#35774#22791#26159#21542#25903#25345#22768#35843#21464#21270
TabOrder = 5
OnClick = Button5Click
end
end
