能否让左右声道的两个音箱同时播放不同的声音？

Question

能否让左右声道的两个音箱同时播放不同的声音？

Answer 1

找到一個控件, 試下, 可用
unit Wave;interfaceuses
  Windows, Messages, SysUtils, Classes, Forms, MMSystem;type
  TWaveArray=array[0..$FFF] of packed record
    R, L: SmallInt;
  end;
  TWave=class;
  TWaveEvent=procedure(Sender: TWave; var Buffer: TWaveArray) of object;
  TWave=class(TComponent)
  private
    FWindow: HWND;
    FHandle: HWAVEOUT;
    FIsPlaying: Boolean;
    FWave: array[0..1] of record
      IsFree: Boolean;
      Hdr: TWaveHdr;
      Buffer: TWaveArray;
    end;
    FOnWave: TWaveEvent;
    procedure PlayWave(Index: Integer);
    procedure FreeWave(Index: Integer);
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Play;
    procedure Stop;
    property Handle: HWAVEOUT read FHandle;
    property IsPlaying: Boolean read FIsPlaying;
  published
    property OnWave: TWaveEvent read FOnWave write FOnWave;
  end;procedure Register;implementation// TWave - public:constructor TWave.Create(AOwner: TComponent);
var
  WF: TPCMWaveformat;
  I: Integer;
begin
  inherited;
  FWindow:=AllocateHWnd(WndProc);
  for I:=0 to 1 do FWave[I].IsFree:=True;
  WF.wf.wFormatTag:=WAVE_FORMAT_PCM;
  WF.wf.nChannels:=2;
  WF.wf.nSamplesPerSec:=44100;
  WF.wf.nAvgBytesPerSec:=176400;
  WF.wf.nBlockAlign:=4;
  WF.wBitsPerSample:=16;
  if waveOutOpen(@FHandle, WAVE_MAPPER, @WF, FWindow, 0, CALLBACK_WINDOW)<>
    MMSYSERR_NOERROR then FHandle:=0;
end;destructor TWave.Destroy;
var
  I: Integer;
begin
  if Handle<>0 then begin
    if IsPlaying then waveOutReset(Handle);
    for I:=0 to 1 do FreeWave(I);
    waveOutClose(Handle);
    FHandle:=0;
  end;
  if FWindow<>0 then DeallocateHWnd(FWindow);
  inherited;
end;procedure TWave.Play;
var
  I: Integer;
begin
  if FIsPlaying then Exit;
  for I:=0 to 1 do PlayWave(I);
end;procedure TWave.Stop;
var
  I: Integer;
begin
  if not IsPlaying then Exit;
  if IsPlaying then waveOutReset(Handle);
  FIsPlaying:=False;
  for I:=0 to 1 do FreeWave(I);
end;// TWave - private:procedure TWave.PlayWave(Index: Integer);
begin
  if not FWave[Index].IsFree or not Assigned(OnWave) then Exit;
  OnWave(Self, FWave[Index].Buffer);
  FWave[Index].Hdr.lpData:=@FWave[Index].Buffer;
  FWave[Index].Hdr.dwBufferLength:=SizeOf(TWaveArray);
  FWave[Index].Hdr.dwUser:=0;
  FWave[Index].Hdr.dwFlags:=0;
  FWave[Index].Hdr.dwLoops:=0;
  if waveOutPrepareHeader(FHandle, @FWave[Index].Hdr, SizeOf(TWAVEHDR))=MMSYSERR_NOERROR
  then
    if waveOutWrite(FHandle, @FWave[Index].Hdr, SizeOf(TWAVEHDR))<>MMSYSERR_NOERROR
    then
      waveOutUnprepareHeader(FHandle, @FWave[Index].Hdr, SizeOf(TWaveHdr))
    else begin
      FWave[Index].IsFree:=False;
      FIsPlaying:=True;
    end;
end;procedure TWave.FreeWave(Index: Integer);
begin
  if FWave[Index].IsFree then Exit;
  if waveOutUnprepareHeader(FHandle, @FWave[Index].Hdr, SizeOf(TWaveHdr))=
    MMSYSERR_NOERROR then FWave[Index].IsFree:=True;
end;procedure TWave.WndProc(var Msg: TMessage);
var
  I: Integer;
begin
  if Msg.Msg<>MM_WOM_DONE then begin
    Msg.Result:=DefWindowProc(FWindow, Msg.Msg, Msg.wParam, Msg.lParam);
    Exit;
  end;
  if not IsPlaying then Exit;
  for I:=0 to 1 do
    if Integer(@FWave[I].Hdr)=Msg.LParam then begin
      FreeWave(I);
      PlayWave(I);
    end;
end;procedure Register;
begin
  RegisterComponents('Test', [TWave]);
end;end.

Answer 2

使用
procedure TForm1.FormCreate(Sender: TObject);
begin
  Wave1.Play;
end;var
  Faza: Real=0;
procedure TForm1.Wave1Wave(Sender: TWave; var Buffer: TWaveArray);
var
  I: Integer;
begin
  for I:=$000 to $FFF do begin
    Buffer[I].R:=Round($7FFF*Cos(Faza));
    Buffer[I].L:=Round($7FFF*Sin(Faza));
    Faza:=Faza+2*PI/44100*261.6;   // nota C
  end;
end;

Answer 3

進一步操作, 而再參考這個
http://www.delphibbs.com/keylife/iblog_show.asp?xid=268