mmdsmix.pas

一套及时通讯的原码

{-- TMMDSSoundBuffer ----------------------------------------------------}
function TMMDSSoundBuffer.GetVolume: Longint;
var
   aResult: DWORD;

begin
   if (DirectSoundBuffer <> nil) and not FMuted then
   begin
      DirectSoundBuffer.GetVolume(aResult);
      FVolume := aResult;
   end;

   Result := FVolume;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.SetPanning(aValue: Longint);
begin
   if (aValue <> FPanning) then
   begin
      FPanning := MinMax(aValue,-10000,10000);
      if (DirectSoundBuffer <> nil) then DirectSoundBuffer.SetPan(FPanning);
   end;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
function TMMDSSoundBuffer.GetPanning: Longint;
var
   aResult: DWORD;

begin
   if (DirectSoundBuffer <> nil) then
   begin
      DirectSoundBuffer.GetPan(aResult);
      FPanning := aResult;
   end;

   Result := FPanning;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.SetFrequency(aValue: Longint);
begin
   if (aValue <> FFrequency) then
   begin
      FFrequency := min(aValue,100000);
      if (DirectSoundBuffer <> nil) then DirectSoundBuffer.SetFrequency(FFrequency);
   end;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
function TMMDSSoundBuffer.GetFrequency: Longint;
var
   aResult: DWORD;

begin
   if (DirectSoundBuffer <> nil) then
   begin
      DirectSoundBuffer.GetFrequency(aResult);
      FFrequency := aResult;
   end;

   Result := FFrequency;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
procedure TMMDSSoundBuffer.SetPosition(aValue: Longint);
begin
   FPosition := aValue;
   if (DirectSoundBuffer <> nil) then
      DirectSoundBuffer.SetCurrentPosition(aValue);
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
function TMMDSSoundBuffer.GetPosition: Longint;
var
   aResult,dummy: DWORD;

begin
   if (DirectSoundBuffer <> nil) then
   begin
      DirectSoundBuffer.GetCurrentPosition(aResult, dummy);
      FPosition := aResult;
   end;

   Result := FPosition;
end;

{-- TMMDSSoundBuffer ----------------------------------------------------}
function TMMDSSoundBuffer.GetBufferLength: Longint;
begin
   Result := 0;
   if (DirectSoundBuffer <> nil) then
   begin
      Result := Caps.dwBufferBytes;
   end;
end;

{== TMMDSWaveMixer ======================================================}
constructor TMMDSWaveMixer.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FLevel := prPriority;
   FBuffers := TList.Create;
   FCaps := TMMDSSoundCaps.Create;
   FSpeakerConfig := scStereo;
   FProductName := '';
   FMuted := False;
   FVolume := 0;
   FPanning := 0;
   FTimerInit := 0;
   DirectSoundObject := nil;
   FPrimaryBuffer := nil;

   FBits := b8Bit;
   FMode := mMono;
   FSampleRate := 11025;

   if _WinNT3_ then
      raise EMMDSWaveMixError.Create(LoadResStr(IDS_DSNOTSUPPORTED));

   if not LoadDSoundDLL then
      raise EMMDSWaveMixError.Create(LoadResStr(IDS_DLLERROR)+' DSOUND.DLL...');

   FDevices := TList.Create;
   DirectSoundEnumerate(DriverEnumerate, FDevices);

   SetDeviceID(0);

   FHandle := AllocateHWnd(WndProc);

   FCoopHandle := 0;

   F3DListener := TMMDS3DListener.Create((AOwner <> nil) and (csLoading in AOwner.ComponentState));

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
destructor TMMDSWaveMixer.Destroy;
begin
   UpdateTimer(False);
   DeallocateHWnd(FHandle);

   { finally close the dsound device and free memory }
   Close;

   if (FCaps <> nil) then FCaps.Free;
   if (FBuffers <> nil) then FBuffers.Free;

   { free the device list }
   FreeDriverList(FDevices);
   FDevices.Free;

   F3DListener.Free;

   inherited Destroy;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure   TMMDSWaveMixer.Loaded;
begin
    inherited Loaded;
    with Sound3D do
    begin
        if MM3DVectorEqual(OrientFront.AsVector,ZeroVector) then
            OrientFront.AsVector := MM3DVector(defOrientFrontX,defOrientFrontY,defOrientFrontZ);
        if MM3DVectorEqual(OrientTop.AsVector,ZeroVector) then
            OrientTop.AsVector := MM3DVector(defOrientTopX,defOrientTopY,defOrientTopZ);
    end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.UpdateTimer(Enable: Boolean);
begin
   KillTimer(FHandle, 1);
   if Enable then
      if SetTimer(FHandle, 1, 50, nil) = 0 then
         raise EOutOfResources.Create({$IFDEF DELPHI3}SNoTimers{$ELSE}LoadStr(SNoTimers){$ENDIF});
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.WndProc(var Msg: TMessage);
var
   i: integer;

begin
   if (Msg.Msg = WM_TIMER) and (Msg.wParam = 1) then
   begin
      for i := 0 to BufferCount-1 do
      with Buffer[i] do
      begin
         if FPlaying and not Playing and not Paused then
         begin
            FPlaying := False;
            dec(FTimerInit);
            if (FTimerInit = 0) then UpdateTimer(False);
            BufferEnd(Buffer[i]);
         end;
      end;
   end
   else with Msg do Result := DefWindowProc(FHandle, Msg, wParam, lParam);
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.BufferLost(Buffer: TMMDSSoundBuffer; Abort: Boolean);
begin
   if assigned(FOnBufferLost) then
      FOnBufferLost(Self, Buffer, Abort)
   else Abort := True;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.BufferEnd(Buffer: TMMDSSoundBuffer);
begin
   if not assigned(Buffer) or (csDestroying in ComponentState) then exit;

   if assigned(FOnBufferEnd) then FOnBufferEnd(Self, Buffer);
   if assigned(Buffer.FOnBufferEnd) then Buffer.FOnBufferEnd(Buffer);
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.GetDevices(Index: integer): PDSDRIVERDESC;
begin
   if Index < NumDevs then
      Result := PDSDRIVERDESC(FDevices.Items[Index])
   else Result := nil;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.SetProductName(aValue: String);
begin
   { dummy }
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
Procedure TMMDSWaveMixer.SetLevel(aValue: TMMDSLevel);
begin
     if (DirectSoundObject <> nil) then
        raise EMMDSWaveMixError.Create(LoadResStr(IDS_PROPERTYOPEN));

     if (FLevel <> aValue) then
     begin
        FLevel := aValue;
     end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.GetNumDevs: integer;
begin
   Result := FDevices.Count;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
Procedure TMMDSWaveMixer.SetDeviceID(DeviceID: TMMDeviceID);
begin
     if (DirectSoundObject <> nil) then
        raise EMMDSWaveMixError.Create(LoadResStr(IDS_PROPERTYOPEN));

     FProductName := LoadResStr(IDS_DSNODEVICE);

     if (NumDevs > 1) and (DeviceID >= 0) and (DeviceID < NumDevs) then
     begin
        GetCaps;
        FProductName := Devices[DeviceID]^.Description;
     end;

   { set the new device }
   FDeviceID := DeviceID;
   if (FDeviceID >= NumDevs) or (FDeviceID < 0) or (NumDevs < 2) then
      FDeviceID := InvalidID;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.SetUse3D(Value: Boolean);
begin
     if (DirectSoundObject <> nil) then
        raise EMMDSWaveMixError.Create(LoadResStr(IDS_PROPERTYOPEN));

     FUse3D := Value;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.Set3DListener(Value: TMMDS3DListener);
begin
    F3DListener.Assign(Value);
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
Procedure TMMDSWaveMixer.SetPrimaryWaveFormat;
var
   wf: TPCMWaveFormat;

begin
   if not (csDesigning in ComponentState) or FWorkInDesign then
   begin
      wf := PCMWaveFormat;

      if (FLevel <> prNormal) and (FPrimaryBuffer <> nil) then
      begin
         if FPrimaryBuffer.SetFormat(@wf) <> DS_OK then
            raise EMMDSWaveMixError.Create('DirectSound PrimaryBuffer SetFormat failed');
      end;
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
Procedure TMMDSWaveMixer.SetPCMWaveFormat(wf: TPCMWaveFormat);
var
   pwfx: PWaveFormatEx;

begin
   pwfx := @wf;
   if not pcmIsValidFormat(pwfx) then
      raise EMMDSWaveMixError.Create(LoadResStr(IDS_INVALIDFORMAT));

   SampleRate := pwfx^.nSamplesPerSec;
   BitLength := TMMBits(pwfx^.wBitsPerSample div 8 - 1);
   Mode := TMMMode(pwfx^.nChannels-1);
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.GetPCMWaveFormat: TPCMWaveFormat;
var
   wfx: TWaveFormatEx;
begin
   pcmBuildWaveHeader(@wfx, (Ord(FBits)+1)*8, Ord(FMode)+1, SampleRate);
   Result := PPCMWaveFormat(@wfx)^;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
Procedure TMMDSWaveMixer.SetBits(aValue: TMMBits);
begin
   if (aValue <> FBits) then
   begin
      FBits := aValue;
      SetPrimaryWaveFormat;
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
Procedure TMMDSWaveMixer.SetMode(aValue: TMMMode);
begin
   if (aValue <> FMode) then
   begin
      FMode := aValue;
      SetPrimaryWaveFormat;
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.SetSampleRate(aValue: Longint);
begin
   if (aValue <> FSampleRate) then
   begin
      FSampleRate := MinMax(aValue, 8000, 100000);
      SetPrimaryWaveFormat;
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.Open;
var
  aResult: DWORD;
  BufferDesc: TDSBUFFERDESC;
  H: THandle;

begin
   if LoadDSoundDLL and (DirectSoundObject = nil) then
   begin
      if (NumDevs < 2) then
          raise EMMDSWaveMixError.Create(LoadResStr(IDS_DSNODEVICE));

      if (DeviceID = InvalidID) then
          raise EMMDSWaveMixError.Create(LoadResStr(IDS_INVALIDDEVICEID));

      try
         DSCheck(DirectSoundCreate(Devices[FDeviceID]^.lpGUID, DirectSoundObject, nil));

         if (FCoopHandle = 0) then
         begin
            H := 0;
            if (Owner <> nil) and (Owner is TForm) then
                H := TForm(Owner).Handle
            {$IFDEF BUILD_ACTIVEX}