waveio.pas

一整套声音录制控件

procedure TWaveAudioIO.DoFilter(const Buffer: Pointer; BufferSize: DWORD);
begin
  if Assigned(fOnFilter) and not (csDestroying in ComponentState) then
    fOnFilter(Self, Buffer, BufferSize);
end;

procedure TWaveAudioIO.Lock;
begin
  EnterCriticalSection(CS);
end;

procedure TWaveAudioIO.Unlock;
begin
  LeaveCriticalSection(CS);
end;

procedure TWaveAudioIO.CreateCallback;
begin
  if Async then
  begin
    fCallbackType := CALLBACK_THREAD;
    fCallback := TWaveThread.Create(Self).ThreadID;
  end
  else
  begin
    fCallbackType := CALLBACK_WINDOW;
    fCallback := AllocateHWnd(CallbackWindowProc);
    WaitForSyncObject(ThreadEvent, INFINITE);
  end;
end;

procedure TWaveAudioIO.DestroyCallback;
begin
  if Callback <> 0 then
  begin
    if ThreadHandle <> 0 then
      while not PostThreadMessage(Callback, WM_QUIT, 0, 0) do
        Sleep(0)
    else
      DeallocateHWnd(Callback);
    fCallback := 0;
  end;
end;

procedure TWaveAudioIO.PostWaveMessage(WaveMsg: DWORD; pWaveHeader: PWaveHdr);
begin
  if Callback <> 0 then
  begin
    if ThreadHandle <> 0 then
      while not PostThreadMessage(Callback, WaveMsg, 0, Integer(pWaveHeader)) do
        Sleep(0)
    else
      PostMessage(Callback, WaveMsg, 0, Integer(pWaveHeader));
  end;
end;

function TWaveAudioIO.ProcessWaveMessage(Msg: DWORD; pWaveHeader: PWaveHdr): Boolean;
begin
  Result := True;
  try
    case Msg of
      MM_WIM_OPEN:
      begin
        EnterCriticalSection(CS);
        try
          DoWaveInDeviceOpen;
        finally
          LeaveCriticalSection(CS);
        end;
      end;
      MM_WIM_DATA:
      begin
        EnterCriticalSection(CS);
        try
          DoWaveInDeviceData(pWaveHeader);
        finally
          LeaveCriticalSection(CS);
        end;
      end;
      MM_WIM_Close:
      begin
        EnterCriticalSection(CS);
        try
          DoWaveInDeviceClose;
        finally
          LeaveCriticalSection(CS);
        end;
      end;
      MM_WOM_OPEN:
      begin
        EnterCriticalSection(CS);
        try
          DoWaveOutDeviceOpen;
        finally
          LeaveCriticalSection(CS);
        end;
      end;
      MM_WOM_DONE:
      begin
        EnterCriticalSection(CS);
        try
          DoWaveOutDeviceDone(pWaveHeader);
        finally
          LeaveCriticalSection(CS);
        end;
      end;
      MM_WOM_CLOSE:
      begin
        EnterCriticalSection(CS);
        try
          DoWaveOutDeviceClose;
        finally
          LeaveCriticalSection(CS);
        end;
      end;
    else
      Result := False;
    end;
  except
    {$IFDEF COMPILER6_UP}
    ApplicationHandleException(Self);
    {$ELSE}
    if Assigned(Application) then
      Application.HandleException(Self);
    {$ENDIF}
  end;
end;

procedure TWaveAudioIO.CallbackWindowProc(var Message: TMessage);
begin
  if not ProcessWaveMessage(Message.Msg, PWaveHdr(Message.LParam)) then
    with Message do Result := DefWindowProc(Callback, Msg, WParam, LParam);
end;

function TWaveAudioIO.Success(mmResult: MMRESULT): Boolean;
begin
  Result := True;
  fLastError := mmResult;
  if mmResult <> MMSYSERR_NOERROR then
  begin
    Result := False;
    DoError;
  end;
end;

function TWaveAudioIO.mmTimeToMS(const mmTime: TMMTime): DWORD;
begin
  case mmTime.wType of
    TIME_MS:
      Result := mmTime.ms;
    TIME_BYTES:
      if WaveFormat.nAvgBytesPerSec <> 0 then
        Result := MulDiv(1000, mmTime.cb, WaveFormat.nAvgBytesPerSec)
      else
        Result := 0;
    TIME_SAMPLES:
      if WaveFormat.nSamplesPerSec <> 0 then
        Result := MulDiv(1000, mmTime.sample, WaveFormat.nSamplesPerSec)
      else
        Result := 0;
    TIME_SMPTE:
      Result := 1000 * ((mmTime.hour * 3600) + (mmTime.min * 60) + mmTime.sec);
  else
    Result := 0;
  end;
end;

function TWaveAudioIO.ReallocateBuffer(var pWaveHeader: PWaveHdr;
  BufferSize: DWORD; Buffer: Pointer): Boolean;
var
  InternalBuffer: Boolean;
begin
  Result := True;
  if BufferSize = 0 then
  begin
    if Assigned(pWaveHeader) then
    begin
      Buffers.Remove(pWaveHeader);
      if pWaveHeader.dwUser = DWORD(Self) then
        ReallocMem(pWaveHeader^.lpData, 0);
      ReallocMem(pWaveHeader, 0);
    end;
  end
  else
  begin
    InternalBuffer := not Assigned(Buffer);
    if not Assigned(pWaveHeader) then
    begin
      try
        ReallocMem(pWaveHeader, SizeOf(TWaveHdr));
        FillChar(pWaveHeader^, SizeOf(TWaveHdr), 0);
        Buffers.Add(pWaveHeader);
      except
        Result := False;
        pWaveHeader := nil;
        Success(MMSYSERR_NOMEM); // Raises an OnError event
      end;
    end;
    if Assigned(pWaveHeader) then
    begin
      if pWaveHeader^.dwUser <> DWORD(Self) then
      begin
        pWaveHeader^.lpData := nil;
        pWaveHeader^.dwBufferLength := 0;
      end;
      if InternalBuffer then
      begin
        Buffer := pWaveHeader^.lpData;
        if pWaveHeader^.dwBufferLength <> BufferSize then
        begin
          try
            ReallocMem(Buffer, BufferSize);
          except
            Result := False;
            ReallocateBuffer(pWaveHeader, 0, nil);
            Success(MMSYSERR_NOMEM); // Raises an OnError event
          end;
        end;
      end
      else if pWaveHeader^.dwUser = DWORD(Self) then
        ReallocMem(pWaveHeader^.lpData, 0);
      if Result then
      begin
        FillChar(pWaveHeader^, SizeOf(TWaveHdr), 0);
        if InternalBuffer then
          pWaveHeader.dwUser := DWORD(Self);
        pWaveHeader^.lpData := Buffer;
        pWaveHeader^.dwBufferLength := BufferSize;
      end;
    end;
  end;
end;

procedure TWaveAudioIO.ResetBuffers;
var
  I: Integer;
  pWaveHeader: PWaveHdr;
begin
  for I := Buffers.Count - 1 downto 0 do
  begin
    pWaveHeader := Buffers[I];
    Buffers.Delete(I);
    ReallocateBuffer(pWaveHeader, 0, nil);
  end;
end;

procedure TWaveAudioIO.WaitForStart;
var
  MSG: TMSG;
begin
  if Callback <> 0 then
  begin
    if ThreadHandle = 0 then
    begin
      while Opening and (Callback <> 0) do
        if PeekMessage(MSG, Callback, 0, 0, PM_REMOVE) then
        begin
          TranslateMessage(MSG);
          DispatchMessage(MSG);
          if MSG.message = WM_QUIT then Exit;
        end;
    end
    else
    begin
      while Opening do
        WaitForSyncObject(ThreadEvent, INFINITE);
    end;
  end;
end;

procedure TWaveAudioIO.WaitForStop;
var
  MSG: TMSG;
begin
  if Callback <> 0 then
  begin
    if ThreadHandle = 0 then
    begin
      while Callback <> 0 do
        if PeekMessage(MSG, Callback, 0, 0, PM_REMOVE) then
        begin
          TranslateMessage(MSG);
          DispatchMessage(MSG);
          if MSG.message = WM_QUIT then Exit;
        end;
    end
    else
    begin
      while Closing do
        WaitForSyncObject(ThreadHandle, INFINITE);
    end;
  end;
end;

function TWaveAudioIO.QueryPCM(PCMFormat: TPCMFormat): Boolean;
var
  WaveFormat: TWaveFormatEx;
begin
  SetPCMAudioFormatS(@WaveFormat, PCMFormat);
  Result := Query(@WaveFormat);
end;

procedure TWaveAudioIO.DoWaveInDeviceOpen;
begin
  DoDeviceOpen;
end;

procedure TWaveAudioIO.DoWaveInDeviceClose;
begin
  DoDeviceClose;
end;

procedure TWaveAudioIO.DoWaveInDeviceData(pWaveHeader: PWaveHdr);
begin
  // The WaveIn class override this
end;

procedure TWaveAudioIO.DoWaveOutDeviceOpen;
begin
  DoDeviceOpen;
end;

procedure TWaveAudioIO.DoWaveOutDeviceClose;
begin
  DoDeviceClose;
end;

procedure TWaveAudioIO.DoWaveOutDeviceDone(pWaveHeader: PWaveHdr);
begin
  // The WaveOut class override this
end;

end.