waveout.pas

一整套声音录制控件

procedure TWaveAudioOut.SetPlaybackRate(const Value: Double);
begin
  if fPlaybackRate <> Value then
  begin
    fPlaybackRate := Value;
    if HandleAllocated and (woSetPlaybackRate in Options) and (dsPlaybackRate in DeviceSupports) then
      waveOutSetPitch(Handle, Float2DW(fPlaybackRate));
  end;
end;

procedure TWaveAudioOut.SetOptions(const Value: TWaveOutOptions);
begin
  if Options <> Value then
  begin
    fOptions := Value;
    if HandleAllocated then AdjustOptionItems;
  end;
end;

function TWaveAudioOut.GetPosition: DWORD;
var
  mmTime: TMMTime;
begin
  Result := StartPosition;
  mmTime.wType := TIME_MS;
  if WaveOutGetPosition(Handle, @mmTime, SizeOf(mmTime)) = MMSYSERR_NOERROR then
    Inc(Result, mmTimeToMS(mmTime));
end;

procedure TWaveAudioOut.SetPosition(Value: DWORD);
begin
  fStartPosition := Value;
  if HandleAllocated then
  begin
    waveOutReset(Handle);
    fPaused := Paused and Success(waveOutPause(Handle));
  end;
end;

function TWaveAudioOut.GetErrorText(ErrorCode: MMRESULT): String;
var
  ErrorText: array[0..255] of Char;
begin
  if waveOutGetErrorText(ErrorCode, ErrorText, SizeOf(ErrorText)) = MMSYSERR_NOERROR then
    Result := StrPas(ErrorText)
  else
    Result := '';
end;

function TWaveAudioOut.IsPitchStored: Boolean;
begin
  Result := (fPitch <> 1.0);
end;

function TWaveAudioOut.IsPlaybackRateStored: Boolean;
begin
  Result := (fPlaybackRate <> 1.0);
end;

procedure TWaveAudioOut.AdjustOptionItems;
var
  Supports: TWaveOutDeviceSupports;
begin
  Supports := DeviceSupports;
  if (woSetVolume in Options) and (dsVolume in Supports) then
    waveOutSetVolume(Handle, Percent2DWVolume(fVolumeLeft, fVolumeRight));
  if (woSetPitch in Options) and (dsPitch in Supports) then
    waveOutSetPitch(Handle, Float2DW(fPitch));
  if (woSetPlaybackRate in Options) and (dsPlaybackRate in Supports) then
    waveOutSetPlaybackRate(Handle, Float2DW(fPlaybackRate));
end;

function TWaveAudioOut.ValidateDeviceID(ADeviceID: DWORD): MMRESULT;
var
  DevCaps: TWaveOutCaps;
begin
  Result := waveOutGetDevCaps(ADeviceID, @DevCaps, SizeOf(DevCaps));
end;

function TWaveAudioOut.InternalOpen: Boolean;
var
  pWaveFormat: PWaveFormatEx;
  FreeWaveFormat: Boolean;
begin
  Result := False;
  if not Opening then
  begin
    if not Active then
    begin
      if Closing then
        WaitForStop;
      Lock;
      Opening := True;
      try
        FreeWaveFormat := True;
        GetWaveFormat(pWaveFormat, FreeWaveFormat);
        try
          if Success(WaveOutOpen(nil, DeviceID, pWaveFormat, 0, 0, WAVE_FORMAT_QUERY)) then
          begin
            Move(pWaveFormat^, WaveFormat, SizeOf(WaveFormat) - SizeOf(WaveFormat.cbSize));
            CreateCallback;
            try
              if Success(WaveOutOpen(@fHandle, DeviceID, pWaveFormat, Callback, 0, CallbackType)) then
                Result := True
              else
                DestroyCallback;
            except
              DestroyCallback;
            end;
          end;
        finally
          if FreeWaveFormat then
            FreeMem(pWaveFormat);
        end;
      finally
        Opening := False;
        Unlock;
      end;
    end
    else
      raise EWaveAudioInvalidOperation.Create('Device is aleardy open');
  end;
end;

function TWaveAudioOut.InternalClose: Boolean;
begin
  Result := False;
  if not Closing then
  begin
    if Opening then
      WaitForStart;
    if Active then
    begin
      Lock;
      try
        Closing := True;
        try
          if Success(WaveOutReset(Handle)) then
            if ActiveBufferCount = 0 then
              Result := Success(WaveOutClose(Handle))
            else
              Result := True
          else
            Closing := False;
        except
          Closing := False;
          raise;
        end;
      finally
        Unlock;
      end;
    end
    else
      raise EWaveAudioInvalidOperation.Create('Device is aleardy close');
  end;
end;

function TWaveAudioOut.InternalPause: Boolean;
begin
  Result := False;
  if not Paused then
  begin
    Lock;
    try
      if not HandleAllocated or Success(WaveOutPause(Handle)) then
      begin
        fPaused := True;
        DoPause;
        Result := True;
      end;
    finally
      Unlock;
    end;
  end;
end;

function TWaveAudioOut.InternalResume: Boolean;
begin
  Result := False;
  if Paused then
  begin
    Lock;
    try
      if not HandleAllocated or Success(WaveOutRestart(Handle)) then
      begin
        fPaused := False;
        DoResume;
        Result := True;
      end;
    finally
      Unlock;
    end;
 end;
end;

function TWaveAudioOut.HandleAllocated: Boolean;
begin
  Result := (Handle <> 0);
end;

function TWaveAudioOut.WriteWaveHeader(const pWaveHeader: PWaveHdr): Boolean;
var
  AlreadyPrepared: Boolean;
begin
  Result := False;
  AlreadyPrepared := LongBool(pWaveHeader^.dwFlags and WHDR_PREPARED);
  if AlreadyPrepared or
     Success(waveOutPrepareHeader(Handle, pWaveHeader, SizeOf(TWaveHdr)))
  then
    try
      DoFilter(pWaveHeader^.lpData, pWaveHeader^.dwBufferLength);
      DoLevel(pWaveHeader^.lpData, pWaveHeader^.dwBufferLength);
      if Success(waveOutWrite(Handle, pWaveHeader, SizeOf(TWaveHdr))) then
        Result := True
      else if not AlreadyPrepared then
        waveOutUnprepareHeader(Handle, pWaveHeader, SizeOf(TWaveHdr));
    except
      if not AlreadyPrepared then
        waveOutUnprepareHeader(Handle, pWaveHeader, SizeOf(TWaveHdr));
      raise;
    end;
end;

function TWaveAudioOut.WriteBuffer(const Buffer: Pointer; BufferSize: DWORD;
  NumLoops: DWORD; FreeIt: Boolean): Boolean;
var
  pWaveHeader: PWaveHdr;
begin
  Result := False;
  pWaveHeader := nil;
  if ReallocateBuffer(pWaveHeader, BufferSize, Buffer) then
  begin
    if FreeIt then
      pWaveHeader^.dwUser := DWORD(Self);
    if NumLoops <> 0 then
    begin
      pWaveHeader^.dwFlags := WHDR_BEGINLOOP or WHDR_BEGINLOOP;
      pWaveHeader^.dwLoops := NumLoops;
    end;
    try
      if WriteWaveHeader(pWaveHeader) then
        Result := True
      else
        ReallocateBuffer(pWaveHeader, 0, nil);
    except
      ReallocateBuffer(pWaveHeader, 0, nil);
    end;
  end;
end;

function TWaveAudioOut.GetWaveDataPtr(out Buffer: Pointer;
  var NumLoops: DWORD; var FreeIt: Boolean): DWORD;
begin
  Result := 0;
end;

function TWaveAudioOut.GetWaveData(const Buffer: Pointer;
  BufferSize: DWORD; var NumLoops: DWORD): DWORD;
begin
  Result := 0;
end;

function TWaveAudioOut.Query(const pWaveFormat: PWaveFormatEx): Boolean;
begin
  Result := (WaveOutOpen(nil, DeviceID, pWaveFormat, 0, 0,
    WAVE_FORMAT_QUERY) = MMSYSERR_NOERROR);
end;

procedure TWaveAudioOut.DefineBuffers;
begin
  if (ActiveBufferCount = 0) and HandleAllocated and not Closing then
    PostWaveMessage(MM_WOM_DONE, nil);
end;

procedure TWaveAudioOut.DoWaveOutDeviceOpen;
begin
  AdjustOptionItems;
  fPaused := Paused and Success(waveOutPause(Handle));
  inherited DoWaveOutDeviceOpen;
end;

procedure TWaveAudioOut.DoWaveOutDeviceClose;
begin
  fHandle := 0;
  fStartPosition := 0;
  inherited DoWaveOutDeviceClose;
end;

procedure TWaveAudioOut.DoWaveOutDeviceDone(pWaveHeader: PWaveHdr);
var
  DataSize: DWORD;
  NumLoops: DWORD;
  Buffer: Pointer;
  FreeBuffer: Boolean;
  MakeSilence: Boolean;
begin
  try
    try
      if Assigned(pWaveHeader) then
        Success(waveOutUnprepareHeader(Handle, pWaveHeader, SizeOf(TWaveHdr)));
      if not Closing and (ActiveBufferCount <= BufferCount) then
      begin
        DataSize := 0;
        NumLoops := 0;
        if BufferInternally then
        begin
          if ReallocateBuffer(pWaveHeader, PreferredBufferSize, nil) then
          begin
            DataSize := GetWaveData(pWaveHeader^.lpData, pWaveHeader^.dwBufferLength, NumLoops);
            if DataSize < pWaveHeader^.dwBufferLength then
              ReallocateBuffer(pWaveHeader, DataSize, nil);
          end;
          Closing := (DataSize = 0);
        end
        else
        begin
          Buffer := nil;
          FreeBuffer := True;
          MakeSilence := False;
          DataSize := GetWaveDataPtr(Buffer, NumLoops, FreeBuffer);
          if not Assigned(Buffer) and (DataSize <> 0) then
          begin
            MakeSilence := True;
            if ActiveBufferCount <= 1 then
            begin
              FreeBuffer := True;
              DataSize := CalcWaveBufferSize(@WaveFormat, DataSize {Silence Duration})
            end
            else
              DataSize := 0;
          end;
          ReallocateBuffer(pWaveHeader, DataSize, Buffer);
          if Assigned(pWaveHeader) and FreeBuffer then
          begin
            pWaveHeader^.dwUser := DWORD(Self);
            if MakeSilence then
              SilenceWaveAudio(pWaveHeader^.lpData, pWaveHeader^.dwBufferLength, @WaveFormat);
          end;
          Closing := (DataSize = 0) and not MakeSilence;
        end;
        if not Closing and Assigned(pWaveHeader) then
        begin
          if NumLoops <> 0 then
          begin
            pWaveHeader^.dwFlags := WHDR_BEGINLOOP or WHDR_ENDLOOP;
            pWaveHeader^.dwLoops := NumLoops;
          end;
          WriteWaveHeader(pWaveHeader);
          if ActiveBufferCount < BufferCount then
            PostWaveMessage(MM_WOM_DONE, nil);
        end;
      end;
    finally
      if Closing and Assigned(pWaveHeader) then
      begin
        if LongBool(pWaveHeader^.dwFlags and WHDR_PREPARED) then
          waveOutUnprepareHeader(Handle, pWaveHeader, SizeOf(TWaveHdr));
        ReallocateBuffer(pWaveHeader, 0, nil);
      end;
    end;
  finally
    if Closing and (ActiveBufferCount = 0) then
      Success(WaveOutClose(Handle));
  end;
end;

end.