mmdsmix.pas

一套及时通讯的原码

            else
                H := ParentWindow
            {$ENDIF}
            ;
            if (H <> 0) then
                CooperateWith(H);
         end
         else
             CooperateWith(FCoopHandle);

         FillChar(BufferDesc, SizeOf(TDSBUFFERDESC), 0);
         with BufferDesc do
         begin
            dwSize := SizeOf(TDSBUFFERDESC);
            dwFlags := DSBCAPS_CTRLVOLUME or DSBCAPS_CTRLPAN or DSBCAPS_PRIMARYBUFFER;
            if Use3D then
                dwFlags := (dwFlags or DSBCAPS_CTRL3D) and not DSBCAPS_CTRLPAN;
         end;

         aResult := DirectSoundObject.CreateSoundBuffer(BufferDesc, FPrimaryBuffer, nil);
         if Use3D then
         begin
            if aResult <> DS_OK then
               if (csDesigning in ComponentState) and not FWorkInDesign then
               begin
                  with BufferDesc do
                       dwFlags := (dwFlags and not DSBCAPS_CTRL3D) or DSBCAPS_CTRLPAN;
                  DSCheck(DirectSoundObject.CreateSoundBuffer(BufferDesc, FPrimaryBuffer, nil));
               end
               else
                  { TODO: Should be resource id }
                  raise EDSMixError.Create('3D sound not available')
            else
                F3DListener.CreateBuffer(FPrimaryBuffer);
         end
         else
         begin
            if (aResult = DSERR_CONTROLUNAVAIL) then
            begin
               with BufferDesc do dwFlags := dwFlags and not DSBCAPS_CTRLVOLUME and not DSBCAPS_CTRLPAN;
               aResult := DirectSoundObject.CreateSoundBuffer(BufferDesc, FPrimaryBuffer, nil);
            end;
            DSCheck(aResult);
         end;

         SetPrimaryWaveFormat;

         SetSpeaker(FSpeakerConfig);

         FPrimaryBuffer.Play(0,0,DSBPLAY_LOOPING);
         
      except
         Close;
         raise;
      end;
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function  TMMDSWaveMixer.GetOpened: Boolean;
begin
    Result := FPrimaryBuffer <> nil;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.CooperateWith(Handle: THandle);
var
    dwLevel: Longint;
begin
    FCoopHandle := Handle;
    if (DirectSoundObject <> nil) then
    begin
        case FLevel of
           prPriority : dwLevel := DSSCL_PRIORITY;
           prExclusive: dwLevel := DSSCL_EXCLUSIVE;
           else dwLevel := DSSCL_NORMAL;
        end;
        DSCheck(DirectSoundObject.SetCooperativeLevel(FCoopHandle, dwLevel));
    end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.Close;
begin
   FreeBuffers;
   if (DirectSoundObject <> nil) then
   begin
      if Use3D then
        F3DListener.FreeBuffer;

      if (FPrimaryBuffer <> nil) then
      begin
         FPrimaryBuffer.Release;
         FPrimaryBuffer := nil;
      end;
      DirectSoundObject.Release;
      DirectSoundObject := nil;
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.SetCaps(aValue: TMMDSSoundCaps);
begin
   { dummy }
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.GetCaps: TMMDSSoundCaps;
var
   aCaps: TDSCAPS;
   wasClosed: Boolean;
begin
   wasClosed := False;
   FillChar(aCaps, SizeOf(TDSCAPS), 0);

   if (DeviceID <> InvalidID) and (NumDevs > 1) then
   try
       { open the device if not open }
       if DirectSoundObject = nil then
       begin
          wasClosed := True;
          Open;
       end;
       try
          aCaps.dwSize := SizeOf(TDSCAPS);
          DirectSoundObject.GetCaps(aCaps);
          with FCaps do
          begin
             FContinuousRate := (aCaps.dwFlags and DSCAPS_CONTINUOUSRATE) > 0;
             FEmulDriver := (aCaps.dwFlags and DSCAPS_EMULDRIVER) > 0;
             FCertified := (aCaps.dwFlags and DSCAPS_CERTIFIED) > 0;
             FPrimary16Bit := (aCaps.dwFlags and DSCAPS_PRIMARY16BIT) > 0;
             FPrimary8Bit := (aCaps.dwFlags and DSCAPS_PRIMARY8BIT) > 0;
             FPrimaryMono := (aCaps.dwFlags and DSCAPS_PRIMARYMONO) > 0;
             FPrimaryStereo := (aCaps.dwFlags and DSCAPS_PRIMARYSTEREO) > 0;
             FSecondary16Bit := (aCaps.dwFlags and DSCAPS_SECONDARY16BIT) > 0;
             FSecondary8Bit := (aCaps.dwFlags and DSCAPS_SECONDARY8BIT) > 0;
             FSecondaryMono := (aCaps.dwFlags and DSCAPS_SECONDARYMONO) > 0;
             FSecondaryStero := (aCaps.dwFlags and DSCAPS_SECONDARYSTEREO) > 0;
             FMin2Sample := aCaps.dwMinSecondarySampleRate;
             FMax2Sample := aCaps.dwMaxSecondarySampleRate;
             FPrimaryBuffers := aCaps.dwPrimaryBuffers;
             FMaxHWAll := aCaps.dwMaxHWMixingAllBuffers;
             FMaxHWStatic := aCaps.dwMaxHWMixingStaticBuffers;
             FMaxHWStream := aCaps.dwMaxHWMixingStreamingBuffers;
             FFreeHWAlls := aCaps.dwFreeHWMixingAllBuffers;
             FFreeHWStatic := aCaps.dwFreeHWMixingStaticBuffers;
             FFreeHWStream := aCaps.dwFreeHWMixingStreamingBuffers;
             FMaxHW3All := aCaps.dwMaxHw3DAllBuffers;
             FMaxHW3Static := aCaps.dwMaxHw3DStaticBuffers;
             FMaxHW3Stream := aCaps.dwMaxHw3DStreamingBuffers;
             FFreeHW3Alls := aCaps.dwFreeHw3DAllBuffers;
             FFreeHW3Static := aCaps.dwFreeHw3DStaticBuffers;
             FFreeHW3Stream := aCaps.dwFreeHw3DStreamingBuffers;
             FTotalHWMemBytes := aCaps.dwTotalHwMemBytes;
             FFreeHWMemBytes := aCaps.dwFreeHwMemBytes;
             FMaxContigFree := aCaps.dwMaxContigFreeHwMemBytes;
             FUnlockRate := aCaps.dwUnlockTransferRateHwBuffers;
             FPlayCPU := aCaps.dwPlayCpuOverheadSwBuffers;
          end;

       finally
          { close the device if it was closed }
          if wasClosed then Close;
       end;

   except
       on E: Exception do
        if (csDesigning in ComponentState) then
            MessageDlg(E.Message,mtError,[mbOk],0)
        else
            raise;
   end;

   Result := FCaps;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.SetMuted(aValue: Boolean);
var
   m: integer;
begin
   if (aValue <> FMuted) then
   begin
      if aValue then
      begin
         if (FPrimaryBuffer <> nil) then
         begin
            m := -10000;
            FPrimaryBuffer.SetVolume(m);
         end;
         FMuted := True;
      end
      else
      begin
         { restore the volume setting }
         if (FPrimaryBuffer <> nil) then
            FPrimaryBuffer.SetVolume(FVolume);
         FMuted := False;
      end;
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.SetVolume(aValue: Longint);
begin
   if (aValue <> FVolume) then
   begin
      FVolume := MinMax(aValue,-10000,0);
      if (FPrimaryBuffer <> nil) and not FMuted then
         FPrimaryBuffer.SetVolume(FVolume);
   end;
end;

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

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

   Result := FVolume;
end;

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

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

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

   Result := FPanning;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.GetBuffer(Index: integer): TMMDSSoundBuffer;
begin
   Result := TMMDSSoundBuffer(FBuffers[Index]);
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.GetBufferName(aName: string): TMMDSSoundBuffer;
var
  i: integer;

begin
   Result := nil;
   for i := 0 to FBuffers.Count-1 do
   if TMMDSSoundBuffer(FBuffers[i]).Name = aName then
   begin
      Result := TMMDSSoundBuffer(FBuffers[i]);
      break;
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.FindFreeName(aName: String): String;
var
   i: integer;

begin
   Result := aName;
   if (BufferByName[aName] <> nil) or (aName = '') then
   begin
      i := 1;
      while BufferByName[aName+IntToStr(i)] <> nil do inc(i);
      Result := aName + IntToStr(i);
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
function TMMDSWaveMixer.GetBufferCount: integer;
begin
   Result := FBuffers.Count;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.CopyData(Buffer: TMMDSSoundBuffer);
Label Ready;
var
  p, pDummy: PChar;
  Length, Dummy: DWORD;
  BufSize: DWORD;
  wfx: TWaveFormatEx;
  pwfxSrc: PWaveFormatEx;
  lpACMConvert: PACMConvert;

begin
   if Buffer.DirectSoundBuffer = nil then exit;

   BufSize := Buffer.Caps.dwBufferBytes;
   if Buffer.DirectSoundBuffer.Lock(0, BufSize, p, Length, pDummy, Dummy, 0) <> DS_OK then
   begin
      Buffer.ReleaseBuffer;
      raise EMMDSWaveMixError.Create('DirectSoundBuffer Lock failed');
   end;

   try
      if (Buffer.Wave.FormatTag <> WAVE_FORMAT_PCM) then
      begin
         if (Buffer.Wave.FormatTag = WAVE_FORMAT_ADPCM) then
         begin
            pwfxSrc := Buffer.Wave.PWaveFormat;
            if adpcmBuildFormatHeader(pwfxSrc, @wfx, 16, 0, 0) then
            begin
               adpcmDecode4Bit(Pointer(pwfxSrc), @wfx, Buffer.Wave.PWaveData, p,
                               Buffer.Wave.PWaveIOInfo^.dwDataBytes);
               goto Ready;
            end;
         end;

         wfx := acmSuggestPCMFormat(Buffer.Wave.PWaveFormat);
         lpACMConvert := acmBeginConvert(Buffer.Wave.PWaveFormat,@wfx,
                                         Buffer.Wave.PWaveData,
                                         Buffer.Wave.PWaveIOInfo^.dwDataBytes,
                                         False);
         if (lpACMConvert <> nil) then
         begin
            acmDoConvert(lpACMConvert, Buffer.Wave.PWaveIOInfo^.dwDataBytes);
            Move(lpACMConvert^.lpDstBuffer^, p^, lpACMConvert^.dwBytesConverted);
            acmDoneConvert(lpACMConvert);
         end
         else raise EMMDSWaveMixError.Create('Unable to convert sound data');
      end
      else
      begin
         Move(Buffer.Wave.PWaveData^, p^, Buffer.Wave.PWaveIOInfo^.dwDataBytes);
      end;

Ready:

   finally
      Buffer.DirectSoundBuffer.Unlock(p, BufSize, nil, 0);
   end;
end;

{-- TMMDSWaveMixer ------------------------------------------------------}
procedure TMMDSWaveMixer.CreateSoundBuffer(pwfx: PWaveFormatEx; dwLength: Longint; Buffer: TMMDSSoundBuffer; Static: Boolean);
var
  BufferDesc: TDSBUFFERDESC;
  m: integer;
begin
   FillChar(BufferDesc, SizeOf(TDSBUFFERDESC), 0);

   with BufferDesc do
   begin
      dwSize := SizeOf(TDSBUFFERDESC);
      dwFlags := DSBCAPS_CTRLDEFAULT or DSBCAPS_STICKYFOCUS or DSBCAPS_GLOBALFOCUS or DSBCAPS_GETCURRENTPOSITION2;
      if Static then
         dwFlags := dwFlags or DSBCAPS_STATIC;

      if Use3D then
        dwFlags := (dwFlags or DSBCAPS_CTRL3D) and not DSBCAPS_CTRLPAN;

      dwBufferBytes := dwLength;
      lpwfxFormat   := pwfx;
   end;

   Buffer.DirectSoundBuffer := nil;

   if DirectSoundObject.CreateSoundBuffer(BufferDesc, Buffer.DirectSoundBuffer, nil) <> DS_OK then
   begin
      { May be we've no 3D sound? }
      if Use3D then
        if (csDesigning in ComponentState) and not FWorkInDesign then
        begin
            with BufferDesc do
                 dwFlags := (dwFlags and not DSBCAPS_CTRL3D) or DSBCAPS_CTRLPAN;