mmconect.pas

一套及时通讯的原码

   { bug fix for AXControl under VB }
   if Longint(Self) = Longint(aValue) then exit;

   case index of
        0: if (FOscope1 = aValue) or ((aValue <> nil) and (FOscope2 = aValue)) then exit
           else FOscope1 := aValue;
        1: if (FOscope2 = aValue) or ((aValue <> nil) and (FOscope1 = aValue)) then exit
           else FOscope2 := aValue;
   end;
   FRefreshScope := False;
   if aValue <> nil then SetWaveParams;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetLight(index: integer; aValue: TMMLight);
begin
   { bug fix for AXControl under VB }
   if Longint(Self) = Longint(aValue) then exit;

   case index of
        0: if (FLight1 = aValue) or ((aValue <> nil) and (FLight2 = aValue)) then exit
           else FLight1 := aValue;
        1: if (FLight2 = aValue) or ((aValue <> nil) and (FLight1 = aValue)) then exit
           else FLight2 := aValue;
   end;
   FRefreshLight := False;
   if aValue <> nil then SetWaveParams;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetSpectrum(index: integer; aValue: TMMSpectrum);
begin
   { bug fix for AXControl under VB }
   if Longint(Self) = Longint(aValue) then exit;

   case index of
        0: if (FSpectrum1 = aValue) then exit else FSpectrum1 := aValue;
        1: if (FSpectrum2 = aValue) then exit else FSpectrum2 := aValue;
        2: if (FSpectrum3 = aValue) then exit else FSpectrum3 := aValue;
        3: if (FSpectrum4 = aValue) then exit else FSpectrum4 := aValue;
   end;
   FRefreshSpectrum := False;
   if aValue <> nil then SetWaveParams;

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

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetSpectrogram(index: integer; aValue: TMMSpectrogram);
begin
   { bug fix for AXControl under VB }
   if Longint(Self) = Longint(aValue) then exit;

   case index of
        0: if (FSpectrogram1 = aValue) or ((aValue <> nil) and (FSpectrogram2 = aValue)) then exit
           else FSpectrogram1 := aValue;
        1: if (FSpectrogram2 = aValue) or ((aValue <> nil) and (FSpectrogram1 = aValue)) then exit
           else FSpectrogram2 := aValue;
   end;
   FRefreshSpectrogram := False;
   if aValue <> nil then SetWaveParams;
end;
{$ENDIF}

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   inherited SetPWaveFormat(aValue);
   SetWaveParams;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetWaveParams;
var
   wfx: TWaveFormatEx;

begin
   if (PWaveFormat <> nil) then
   begin
      if not FStarted then
      begin
         FCanConvert := False;

         if (PWaveFormat^.wFormatTag = WAVE_FORMAT_PCM) then
         begin
            FIsPCMFormat := True;
            wfx          := PWaveFormat^;
         end
         else
         begin
            FIsPCMFormat := False;
            if FAutoConvert then
            begin
               wfx := acmSuggestPCMFormat(PWaveFormat);
               if (wfx.wFormatTag <> 0) then
                   FCanConvert := acmQueryConvert(PWaveFormat,@wfx,True);
            end;
         end;
      end
      else wfx := FDstWaveFormat^;

      if (FIsPCMFormat or FCanConvert) then
      begin
         if wfx.wBitsPerSample = 8 then
            FSilence := 128
         else
            FSilence := 0;

         if assigned(FLevel1) then
            FLevel1.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FLevel2) then
            FLevel2.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         {$IFNDEF LEVEL_ONLY}
         if assigned(FMeter1) then
            FMeter1.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FMeter2) then
            FMeter2.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FOscope1) then
            FOscope1.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FOscope2) then
            FOscope2.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FLight1) then
            FLight1.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FLight2) then
            FLight2.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FSpectrum1) then
            FSpectrum1.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FSpectrum2) then
            FSpectrum2.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FSpectrum3) then
            FSpectrum3.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FSpectrum4) then
            FSpectrum4.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FSpectrogram1) then
            FSpectrogram1.PCMWaveFormat := PPCMWaveFormat(@wfx)^;

         if assigned(FSpectrogram2) then
            FSpectrogram2.PCMWaveFormat := PPCMWaveFormat(@wfx)^;
         {$ENDIF}
      end;
   end;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.Started;
var
   wfx: TWaveFormatEx;
begin
   inherited Started;

   if not (csDesigning in ComponentState) and
          (PWaveFormat <> nil) and not FStarted then
   begin
      FSrcData := nil;
      FDstData := nil;

      if (PWaveFormat^.wFormatTag = WAVE_FORMAT_PCM) then
      begin
         FIsPCMFormat := True;
         FCanConvert  := False;
         FDstWaveFormat := PWaveFormat;
         FDstBufferSize := BufferSize;
         FSrcData := GlobalAllocMem(BufferSize);
         FDstData := FSrcData;
      end
      else
      begin
         FIsPCMFormat := False;
         FCanConvert := False;

         if FAutoConvert then
         begin
            wfx := acmSuggestPCMFormat(PWaveFormat);
            FDstWaveFormat := wioCopyWaveFormat(@wfx);
            FSrcData := GlobalAllocMem(BufferSize);

            FConvert := acmBeginConvert(PWaveFormat,FDstWaveFormat,FSrcData,BufferSize,True);
            if (FConvert <> nil) then
            begin
               FCanConvert := True;
               FDstData := FConvert^.lpDstBuffer;
               FDstBufferSize := FConvert^.dwDstBufferSize;
            end
            else
            begin
               GlobalFreeMem(Pointer(FSrcData));
               GlobalFreeMem(Pointer(FDstWaveFormat));
               FDstBufferSize := 0;
            end;
         end;
      end;

      FRefreshLevel       := False;
      {$IFNDEF LEVEL_ONLY}
      FRefreshMeter       := False;
      FRefreshScope       := False;
      FRefreshLight       := False;
      FRefreshSpectrum    := False;
      FRefreshSpectrogram := False;
      {$ENDIF}

      FLevelRefresh       := 0;
      {$IFNDEF LEVEL_ONLY}
      FMeterRefresh       := 0;
      FOscopeRefresh      := 0;
      FLightRefresh       := 0;
      FSpectrumRefresh    := 0;
      FSpectrogramRefresh := 0;
      {$ENDIF}

      if (FIsPCMFormat or FCanConvert) and (FDstData <> nil) then
      begin
         {$IFDEF WIN32}
         FillChar(FDataSection, SizeOf(FDataSection), 0);
         InitializeCriticalSection(FDataSection);
         {$ENDIF}

         UpdateSpeed(Self);
         FStarted := True;
         SetWaveParams;
         if FEnabled and FRealTime then
         begin
            if FAutoTrigger and ENTER_IDLE_MODE then
            begin
               {$IFDEF WIN32}
               if not assigned(Application.OnIdle) and (IdleHandler = nil) then
               begin
                  IdleHandler := TIdleHandler.Create;
                  Application.OnIdle := IdleHandler.Idle;
                  RestoreIdle := True;
               end;
               {$ENDIF}
            end;
            PostMessage(ConnectorWindow,CM_CON_START,0,Longint(Self));
         end;
      end;
   end;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.Paused;
begin
   if not (csDesigning in ComponentState) and FStarted and not FPaused then
   begin
      FPaused := True;

      if (FDstData <> nil) and (FIsPCMFormat or FCanConvert) then
          GlobalFillMem(FDstData^, FDstBufferSize, FSilence);

      if FRealTime then UpdateTimer(True);
   end;

   inherited Paused;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.Restarted;
begin
   if not (csDesigning in ComponentState) and FPaused then
   begin
      FPaused := False;
      if FRealTime then UpdateTimer(False);
   end;

   inherited Restarted;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.Stopped;
begin
   if not (csDesigning in ComponentState) and FStarted then
   begin
      FStarted := False;
      if FRunning then
      begin
         FRunning := False;
         if FAutoTrigger then dec(LoopStarted);

         if (LoopStarted = 0) and RestoreIdle then
         begin
            Application.OnIdle := nil;
            IdleHandler.Free;
            IdleHandler := nil;
            RestoreIdle := False;
         end;
      end;
      FPaused := False;
      UpdateTimer(False);

      if FCanConvert and (FConvert <> nil) then
      begin
         acmDoneConvert(FConvert);
         FDstData := nil;
         GlobalFreeMem(Pointer(FDstWaveFormat));
      end;

      GlobalFreeMem(Pointer(FSrcData));

      {$IFDEF WIN32}
      DeleteCriticalSection(FDataSection);
      {$ENDIF}

      if FRefresh then
      begin
         if assigned(FLevel1) then FLevel1.ResetData;
         if assigned(FLevel2) then FLevel2.ResetData;
         {$IFNDEF LEVEL_ONLY}
         if assigned(FMeter1) then FMeter1.ResetData;
         if assigned(FMeter2) then FMeter2.ResetData;
         if assigned(FOscope1) then FOscope1.ResetData;
         if assigned(FOscope2) then FOscope2.ResetData;
         if assigned(FLight1) then FLight1.ResetData;
         if assigned(FLight2) then FLight2.ResetData;
         if assigned(FSpectrum1) then FSpectrum1.ResetData;
         if assigned(FSpectrum2) then FSpectrum2.ResetData;
         if assigned(FSpectrum3) then FSpectrum3.ResetData;
         if assigned(FSpectrum4) then FSpectrum4.ResetData;
         if assigned(FSpectrogram1) then FSpectrogram1.ResetData;
         if assigned(FSpectrogram2) then FSpectrogram2.ResetData;
         {$ENDIF}
      end;
   end;

   inherited Stopped;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.Reseting;
begin
   if not (csDesigning in ComponentState) and FStarted then
   begin
      if (FDstData <> nil) and (FIsPCMFormat or FCanConvert) then
          GlobalFillMem(FDstData^, FDstBufferSize, FSilence);
   end;

   inherited Reseting;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.ProcessData;
var
   Offset: Longint;
   DataPtr,DataPtr2: PChar;
   Size,Size2: integer;
   TimeOK,Time2OK: Boolean;
   {$IFNDEF LEVEL_ONLY}
   Scope: TMMOscope;
   {$ENDIF}

begin
   if FEnabled and (FRunning or (not FRealtime and FStarted)) and (FDstData <> nil) then
   begin
      {$IFDEF WIN32}
      EnterCriticalSection(FDataSection);
      try
      {$ENDIF}
         if FRefreshLevel then
         begin
            Size := 0;
            DataPtr := FDstData;
            TimeOK := True;

            if assigned(FLevel1) then Size := FLevel1.BytesPerLevel;
            if assigned(FLevel2) then Size := Max(Size,FLevel2.BytesPerLevel);

            if Synchronize then
            begin
               FStepTime := 1000000;
               FStepTime := Trunc(FStepTime*FIndexLevel/FDstWaveFormat^.nAvgBytesPerSec);
               if (TimeGetExactTime-FBufTime < FStepTime) then
               begin
                  TimeOK := False;
               end;
            end;

            if TimeOK then
            begin
               inc(DataPtr,FIndexLevel);
               inc(FIndexLevel,Size);
               if (DataPtr + Size <= FDstData + FRealBufferSize) then
               begin
                  { paint the level. }
                  if assigned(FLevel1) then FLevel1.RefreshPCMData(DataPtr);
                  if assigned(FLevel2) then FLevel2.RefreshPCMData(DataPtr);
                  inc(FLevelRefresh);
               end
               else FRefreshLevel := False;
            end;
         end;

         {$IFNDEF LEVEL_ONLY}
         if FRefreshMeter then
         begin
            Size := 0;
            DataPtr := FDstData;
            TimeOK := True;

            if assigned(FMeter1) then Size := FMeter1.BytesPerMeter;
            if assigned(FMeter2) then Size := Max(Size,FMeter2.BytesPerMeter);

            if FSynchronize then
            begin
               FStepTime := 1000000;