⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mmacmcvt.pas

📁 一套及时通讯的原码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Closed;
begin
   Close;

   inherited Closed;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Started;
begin
   inherited Started;

   Start;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Stopped;
begin

   Stop;

   inherited Stopped;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.Reseting;
begin
   inherited Reseting;

   if (FPACMConvert <> nil) then
   begin
      acmFlushConvert(FPACMConvert);
      FDone := False;
   end;
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.BufferReady(lpwh: PWaveHdr);
var
   nBytes,nRead,nWrite,nConvert: Longint;

begin
   if FOpen and FStarted then
   begin
      { write Data }
      if (Output <> nil) then
      begin
         if FMustConvert and FCanConvert and (FPACMConvert <> nil) then
         with FPACMConvert^ do
         begin
            nBytes := lpwh^.dwBytesRecorded;
            nRead := 0;
            while FStarted and (nBytes > 0) do
            begin
               nConvert := Min(nBytes,dwSrcBufferSize);
               GlobalMoveMem(PChar(lpwh^.lpData+nRead)^,lpSrcBuffer^,nConvert);
               try
                  if acmDoConvert(FPACMConvert,nConvert) <= 0 then
                  begin
                     if not bPending and not bQueued then
                     begin
                        FCanConvert := False;
                        raise EMMConverterError.Create('Unable to convert to destination format');
                        exit;
                     end;
                  end;
               except
                  FCanConvert := False;
                  raise;
               end;
               dec(nBytes,nConvert);
               inc(nRead,nConvert);

               while FStarted and (dwBytesRead < dwBytesConverted) do
               begin
                  GlobalFillMem(Ftwh,sizeOf(Ftwh),0);

                  nWrite := Min(dwBytesConverted-dwBytesRead,BufferSize);

                  Ftwh.wh.lpData := PChar(lpDstBuffer+dwBytesRead);
                  Ftwh.wh.dwBufferLength := nWrite;
                  Ftwh.wh.dwBytesRecorded:= nWrite;

                  inc(dwBytesRead,nWrite);
                  inherited BufferReady(@Ftwh);
               end;
            end;
         end
         else inherited BufferReady(lpwh);
      end;
   end
   else inherited BufferReady(lpwh);
end;

{-- TMMACMConverter ------------------------------------------------------------}
procedure TMMACMConverter.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
Label CopyData;
var
   nRead,nBytes: Longint;
   TryCount: integer;

begin
   if FOpen and FStarted then
   begin
      { read Data }
      if (Input <> nil) then
      begin
         TryCount := 0;
         nBytes   := lpwh^.dwBufferLength;

         if FMustConvert and FCanConvert and (FPACMConvert <> nil) then
         with FPACMConvert^ do
         begin
CopyData:
            { get some data from the conversion buffer }
            if (dwBytesConverted-dwBytesRead > 0) then
            begin
               nRead := Min(dwBytesConverted-dwBytesRead,nBytes);
               GlobalMoveMem((lpDstBuffer+dwBytesRead)^,(lpwh^.lpData+lpwh^.dwBytesRecorded)^,nRead);
               dec(nBytes,nRead);
               inc(dwBytesRead,nRead);
               inc(lpwh^.dwBytesRecorded,nRead);
            end;

            if not PMMWaveHdr(lpwh)^.LoopRec.dwLooping then
            begin
               { do we need more data ? }
               if FStarted and (nBytes > 0) then
               begin
                  if not FDone then
                  begin
                     GlobalFillMem(Ftwh,sizeOf(Ftwh),0);

                     Ftwh.wh.lpData := lpSrcBuffer;
                     Ftwh.wh.dwBufferLength := dwSrcBufferSize;
                     Ftwh.LoopRec := PMMWaveHdr(lpwh)^.LoopRec;

                     FMoreBuffers := False;
                     inherited BufferLoad(@Ftwh,FMoreBuffers);

                     nRead := Ftwh.wh.dwBytesRecorded;
                     PMMWaveHdr(lpwh)^.LoopRec := Ftwh.LoopRec;

                     if not FMoreBuffers or (nRead <= 0) then FDone := True;
                  end
                  else nRead := 0;

                  if (nRead > 0) and FStarted then
                  begin
                     if acmDoConvert(FPACMConvert,nRead) <= 0 then
                     begin
                        if not FDone then
                        begin
                           inc(TryCount);
                           if (TryCount < 5) then goto CopyData;

                           FCanConvert := False;
                           raise EMMConverterError.Create('Unable to convert to destination format');
                           exit;
                        end
                        else
                        begin
                           if (acmEndConvert(FPACMConvert,nRead) > 0) then
                               goto CopyData;
                        end;
                     end
                     else if FStarted then goto CopyData;
                  end
                  else if FStarted then
                  begin
                     if (acmEndConvert(FPACMConvert,0) > 0) then goto CopyData;
                  end;
               end;
            end;
            MoreBuffers := FMoreBuffers or (dwBytesConverted-dwBytesRead > 0) or bPending;
         end
         else inherited BufferLoad(lpwh,MoreBuffers);
      end;
   end
   else inherited BufferLoad(lpwh,MoreBuffers);
end;

{== TMMPCMConverter ============================================================}
constructor TMMPCMConverter.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   FAutoConvert := True;
   FSampleRate  := 11025;
   FBits        := b8Bit;
   FMode        := mMono;
   FRequired    := [rpBits,rpChannels,rpSampleRate];

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

{-- TMMPCMConverter ------------------------------------------------------------}
procedure TMMPCMConverter.SuggestFormat;
var
   wfx,wfx2: TWaveFormatEx;
begin
   GlobalFreeMem(Pointer(FCvtFormat));

   if not FEnabled then exit;

   if FAutoConvert and (FPSrcFormat <> nil) then
   begin
      wfx := acmSuggestPCMFormat(FPSrcFormat);
   end
   else
   begin
      if (FPSrcFormat <> nil) then
      begin
         wfx2 := acmSuggestPCMFormat(FPSrcFormat);

         if (rpBits in FRequired) then
             wfx2.wBitsPerSample := (Ord(FBits)+1)*8;
         if (rpChannels in FRequired) then
             wfx2.nChannels := Ord(FMode)+1;
         if (rpSampleRate in FRequired) then
             wfx2.nSamplesPerSec := FSampleRate;

         pcmBuildWaveHeader(@wfx,wfx2.wBitsPerSample,wfx2.nChannels,wfx2.nSamplesPerSec);
      end
      else pcmBuildWaveHeader(@wfx,(Ord(FBits)+1)*8,Ord(FMode)+1,FSampleRate);
   end;
   if (wfx.wFormatTag <> 0) then
       FCvtFormat := wioCopyWaveFormat(@wfx);
end;

{-- TMMPCMConverter ------------------------------------------------------------}
procedure TMMPCMConverter.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> nil) and not (csLoading in ComponentState) and not (csDestroying in ComponentState) then
   begin
      if not (csDesigning in ComponentState) then
         if not pcmIsValidFormat(aValue) then
            raise EMMConverterError.Create(LoadResStr(IDS_INVALIDFORMAT));

      inherited SetPWaveFormat(aValue);
   end;
end;

{-- TMMPCMConverter ------------------------------------------------------------}
procedure TMMPCMConverter.SetAutoConvert(aValue: Boolean);
begin
   if (aValue <> FAutoConvert) then
   begin
      FAutoConvert := aValue;
      SetWaveParams;
   end;
end;

{-- TMMPCMConverter ------------------------------------------------------------}
procedure TMMPCMConverter.SetWaveParams;
begin
   SuggestFormat;
   if (FCvtFormat <> nil) then
       PWaveFormat := FCvtFormat
   else
       PWaveFormat := FPSrcFormat;
end;

{-- TMMPCMConverter ------------------------------------------------------------}
Procedure TMMPCMConverter.SetRequired(aValue: TMMRequiredParams);
begin
     if (FRequired <> aValue) then
     begin
        FRequired := aValue;
        SetWaveParams;
     end;
end;

{-- TMMPCMConverter ------------------------------------------------------------}
Procedure TMMPCMConverter.SetSampleRate(Rate: Longint);
begin
     if (Rate <> SampleRate) then
     begin
        FSampleRate := MinMax(Rate,8000,88200);
        SetWaveParams;
     end;
end;

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

{-- TMMPCMConverter ------------------------------------------------------------}
Procedure TMMPCMConverter.SetMode(aValue: TMMMode);
begin
   if (aValue <> FMode) and (aValue in [mMono,mStereo]) then
   begin
      FMode := aValue;
      SetWaveParams;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -