操作 Wave 文件(14): waveOutSetPlaybackRate、waveOutSetPitch

这两个参数也都是可以 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