mmwavin.pas

一套及时通讯的原码

   inherited Create(AOwner);

   SetupWaveEngine;

   { Set defaults }
   FHWaveIn       := 0;
   FState         := [wisClose];
   FError         := 0;
   FNumBuffers    := 10;
   FMode          := mMono;
   FBits          := b8Bit;
   FRate          := 11025;
   FProductName   := '';
   FDriverVersion := 0;
   FBytesRecorded := 0;
   FTimeFormat    := tfByte;
   FCallBackMode  := cmWindow;
   FStopping      := False;
   FPosted        := False;
   FClosing       := False;
   FReseting      := False;
   FMaxRecTime    := -1;
   FMaxRecBytes   := MaxLongint;
   FPriority      := tpHigher;

   FAllocator     := TMMAllocator.Create;

   FBufferIndex := 0;

   { clear all pointers to Nil }
   FillChar(FWaveInHdrs, sizeOf(TMMWaveInHdrs), 0);

   FNumDevs := waveInGetNumDevs;

   SetWaveParams;

   SetDeviceID(0);

   {$IFDEF WIN32}
   DataSectionOK := False;
   {$ENDIF}

   { Create the window for callback notification }
   if not (csDesigning in ComponentState) then
           FHandle := AllocateHwnd(WaveInHandler);

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

{-- TMMCustomWaveIn ------------------------------------------------------------}
destructor TMMCustomWaveIn.Destroy;
begin
   { Close the device if it's open }
   if (FHWaveIn <> 0) then Close;

   { Destroy the window for callback notification }
   if (FHandle <> 0) then DeallocateHwnd(FHandle);

   if (FAllocator <> nil) then FAllocator.Free;

   inherited Destroy;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.Error(Msg: string);
begin
   if assigned(FOnError) then FOnError(Self);

   raise EMMWaveInError.Create(Msg);
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
{ Allocate memory for the WaveIn header and buffers }
procedure TMMCustomWaveIn.AllocWaveHeaders;
Var
   i: integer;
   lpwh: PWaveHdr;

begin
   if (BufferSize > 0) then
   begin
      for i := 0 to FNumBuffers-1 do
      begin
         if (FWaveInHdrs[i] = Nil) then
         begin
              { set up a wave header for recording and lock     }
              lpwh := FAllocator.AllocBuffer(GPTR, SizeOf(TMMWaveHdr) + BufferSize);
              if lpwh = NIL then
                 Error(LoadResStr(IDS_HEADERMEMERROR));

              { Data occurs directly after the header }
              lpwh^.lpData         := PChar(lpwh) + sizeOf(TMMWaveHdr);
              lpwh^.dwBufferLength := BufferSize;
              lpwh^.dwBytesRecorded:= 0;
              lpwh^.dwFlags        := 0;
              lpwh^.dwLoops        := 0;
              lpwh^.dwUser         := 0;
              lpwh^.lpNext         := nil;
              FWaveInHdrs[i]       := lpwh;
         end;
      end;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
procedure TMMCustomWaveIn.FreeWaveHeaders;
Var
   i: integer;

begin
   for i := 0 to FNumBuffers-1 do
   begin
      { unlock and free memory for WaveInHdr }
      if FWaveInHdrs[i] <> NIL then
      begin
         FAllocator.FreeBuffer(Pointer(FWaveInHdrs[i]));
         FWaveInHdrs[i] := Nil;
      end;
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
function TMMCustomWaveIn.WaveInErrorString(WError: integer): String;
Var
   errorDesc: PChar;

begin
   { convert the numeric return code from an MMSYSTEM function to a string }
   errorDesc := Nil;
   try
      errorDesc := StrAlloc(MAXERRORLENGTH);
      if waveInGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then
         Result := StrPas(errorDesc)
      else
         Result := LoadResStr(IDS_ERROROUTOFRANGE);

   finally
      StrDispose(errorDesc);
   end;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
Procedure TMMCustomWaveIn.SetDeviceID(aValue: TMMDeviceID);
begin
   if (wisOpen in FState) then
      Error(LoadResStr(IDS_PROPERTYOPEN));

   FProductName := LoadResStr(IDS_WINODEVICE);
   FDriverVersion := 0;

   if (FNumDevs > 0) and (aValue >= MapperId) and (aValue < FNumDevs) then
   begin
      { Set the name and other WAVEINCAPS properties to match the ID }
      FError := waveInGetDevCaps(aValue, @FWaveInCaps, sizeof(TWaveInCaps));
      if FError = 0 then
      with FWaveInCaps do
      begin
         FProductName := StrPas(szPname);
         FDriverVersion := vDriverVersion;
      end
   end;

   { set the new device }
   FDeviceID := aValue;
   if (aValue < MapperId) or (aValue >= FNumDevs) then
       FDeviceID := InvalidID;

   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
function TMMCustomWaveIn.GetDeviceID: TMMDeviceID;
begin
   Result := FDeviceID;
end;

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

{-- TMMCustomWaveIn ------------------------------------------------------------}
function TMMCustomWaveIn.GetProductName: String;
begin
   Result := FProductName;
end;

{-- TMMCustomWaveIn ------------------------------------------------------------}
function TMMCustomWaveIn.QueryDevice(aDeviceID: TMMDeviceID; pwfx: PWaveFormatEx): Boolean;
Var
   aRate: Word;
   aMode: Word;
   aBits: Word;
   aWaveInCaps: TWaveInCaps;
   aHandle: HWaveIn;

begin
   if (aDeviceID >= MapperId) and (aDeviceID < FNumDevs) and (pwfx <> nil) then
   begin
      { query the Wave input device. }
      Result := WaveInOpen(@aHandle,
                           aDeviceId,
                           Pointer(pwfx),
                           0, 0,
                           WAVE_FORMAT_QUERY) = 0;

      if Result and (pwfx^.wFormatTag = WAVE_FORMAT_PCM) then
      begin
         Result := waveInGetDevCaps(aDeviceID,
                                    @aWaveInCaps,
                                    sizeof(TWaveInCaps)) = 0;
         if Result then
         with aWaveInCaps do
         begin
             aRate := pwfx^.nSamplesPerSec;
             aMode := pwfx^.nChannels;
             aBits := pwfx^.wBitsPerSample;
             case aRate of
             8000..11025: case aMode of
                             1: case aBits of
                                   8: Result := (dwFormats AND Wave_Format_1M08 <> 0);
                                  16: Result := (dwFormats AND Wave_Format_1M16 <> 0);
                                end;
                             2: case aBits of
                                   8: Result := (dwFormats AND Wave_Format_1S08 <> 0);
                                  16: Result := (dwFormats AND Wave_Format_1S16 <> 0);
                                end;
                          end;
            11026..22050: case aMode of
                             1: case aBits of
                                   8: Result := (dwFormats AND Wave_Format_2M08 <> 0);
                                  16: Result := (dwFormats AND Wave_Format_2M16 <> 0);
                                end;
                             2: case aBits of
                                   8: Result := (dwFormats AND Wave_Format_2S08 <> 0);
                                  16: Result := (dwFormats AND Wave_Format_2S16 <> 0);
                                end;
                          end;
            22051..48000: case aMode of
                             1: case aBits of
                                   8: Result := (dwFormats AND Wave_Format_4M08 <> 0);
                                  16: Result := (dwFormats AND Wave_Format_4M16 <> 0);
                                end;
                             2: case aBits of
                                   8: Result := (dwFormats AND Wave_Format_4S08 <> 0);
                                  16: Result := (dwFormats AND Wave_Format_4S16 <> 0);
                                end;
                          end;
             end;
         end;
      end;
   end
   else Result := False;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomWaveIn -----------------------------------------------------------}
procedure TMMCustomWaveIn.SetTimeFormat(aValue: TMMTimeFormats);
begin
   if (aValue <> FTimeFormat) then
   begin
      FTimeFormat := aValue;

      if (FMaxRecTime >= 0) then
      begin
         case FTimeFormat of
             tfMillisecond: FMaxRecTime := wioBytesToTime(PWaveFormat,FMaxRecBytes);
             tfSample     : FMaxRecTime := wioBytesToSamples(PWaveFormat,FMaxRecBytes);
           else FMaxRecTime:= FMaxRecBytes;
         end;
      end;
   end;
end;

{-- TMMCustomWaveIn -----------------------------------------------------------}
procedure TMMCustomWaveIn.SetMaxRecTime(aValue: Longint);
begin
   if (aValue <> FMaxRecTime) then
   begin
      FMaxRecTime := aValue;
      CalcMaxRecBytes;
   end;
end;

{-- TMMCustomWaveIn -----------------------------------------------------------}
procedure TMMCustomWaveIn.CalcMaxRecBytes;
begin
   if (FMaxRecTime >= 0) and (PWaveFormat <> nil) then
   begin
      try
         case FTimeFormat of
            tfMillisecond: FMaxRecBytes := wioTimeToBytes(PWaveFormat,FMaxRecTime);
            tfSample     : FMaxRecBytes := wioSamplesToBytes(PWaveFormat,FMaxRecTime);
            else FMaxRecBytes := FMaxRecTime;
         end;
      except
         FMaxRecBytes := MaxLongint;
      end;
   end
   else FMaxRecBytes := MaxLongint;
   FMaxRecBytes := FMaxRecBytes-(FMaxRecBytes mod PWaveFormat^.nBlockAlign);
end;

{-- TMMCustomWaveIn -----------------------------------------------------------}
procedure TMMCustomWaveIn.SetPriority(aValue: TThreadPriority);
begin
   FPriority := aValue;
   if (FInThread <> nil) then
       FInThread.Priority := FPriority;
end;

{-- TMMCustomWaveIn -----------------------------------------------------------}
function TMMCustomWaveIn.GetSamplePosition: Cardinal;
Var
   MMTime: TMMTime;

begin
   Result := 0;
   if (wisOpen in FState) and (PWaveFormat <> Nil) and not FClosing then
   begin
      MMTime.wType := Time_Samples;
      FError := WaveInGetPosition(FHWaveIn, @MMTime, SizeOf(TMMTime));
      if (FError <> 0) or (MMTime.wType <> Time_Samples) then
      begin
         MMTime.wType := Time_Bytes;
         FError := WaveInGetPosition(FHWaveIn, @MMTime, SizeOf(TMMTime));
         if (FError <> 0) then
             Error('WaveInGetPosition:'#10#13+WaveInErrorString(FError));

         MMTime.Sample := wioBytesToSamples(PWaveFormat,MMTime.cb);
      end;
      Result := MMTime.Sample;
   end;
end;

{-- TMMCustomWaveIn -----------------------------------------------------------}
function TMMCustomWaveIn.GetInternalPosition: Int64;
var
   Samples,Pos: int64;
   S: Cardinal;
   WrapSize: int64;
begin
   Result := 0;
   if (wisOpen in FState) and (PWaveFormat <> Nil) and not FCloseIt then
   begin
      S := GetSamplePosition;
      {$IFDEF WIN32}
      asm
         mov   eax, S
         mov   dword ptr Pos[0], eax
         xor   eax, eax
         mov   dword ptr Pos[4], eax

         mov   eax, Self
         mov   eax, TMMWaveIn(eax).FWrapSize
         mov   dword ptr WrapSize[0], eax
         xor   eax, eax
         mov   dword ptr WrapSize[4], eax
      end;

      Samples := (FWrapArrounds*WrapSize)+Pos;
      {$ELSE}
      Samples := S;
      {$ENDIF}

      case FTimeFormat of
           tfMilliSecond: Result := wioSamplesToTime64(PWaveFormat,Samples);
           tfByte       : Result := wioSamplesToBytes64(PWaveFormat,Samples);
           tfSample     : Result := Samples;
      end;

      if (FMaxRecTime > 0) and (Result >= FMaxRecTime) then
          Result := FMaxRecTime;
   end;
end;

{-- TMMCustomWaveIn -----------------------------------------------------------}
function TMMCustomWaveIn.GetPosition: MM_int64;
{$IFNDEF DELPHI4}
var
   Temp: TLargeInteger;
{$ENDIF}
begin
   {$IFDEF DELPHI4}
   Result := GetInternalPosition;
   {$ELSE}
   Temp.QuadPart := GetInternalPosition;
   Result := Temp.LowPart;
   {$ENDIF}
end;