mmconect.pas

一套及时通讯的原码

   if (ConnectorList <> nil) then
   for i := 0 to ConnectorList.Count-1 do
   with TMMConnector(ConnectorList.Items[i]) do
   begin
      if FSpeed > LoopSpeed then LoopSpeed := FSpeed;
   end;
end;

{------------------------------------------------------------------------}
procedure AddConnector(Connector: TMMConnector);
begin
   inc(ConnectorCount);
   if (ConnectorCount = 1) then
   begin
      ConnectorList := TList.Create;
      ConnectorWindow := AllocateConnectorWindow;
   end;
   ConnectorList.Add(Connector);
   UpdateSpeed(Connector);
end;

{------------------------------------------------------------------------}
procedure RemoveConnector(Connector: TMMConnector);
begin
   if (ConnectorList = nil) or (ConnectorList.indexOf(Connector) = -1) then exit;

   ConnectorList.Remove(Connector);
   ConnectorList.Pack;
   dec(ConnectorCount);
   if (ConnectorCount = 0) then
   begin
      ConnectorList.Free;
      ConnectorList := nil;
      DestroyWindow(ConnectorWindow);
      ConnectorWindow := 0;
   end;
end;

{------------------------------------------------------------------------}
procedure TimeCallBack(uTimerID, dwUser: Longint);
begin
  if (dwUser <> 0) then
  with TMMConnector(dwUser) do
  begin
     if FPaused then
     begin
        FBufTime := TimeGetExactTime;

        if assigned(FLevel1) or assigned(FLevel2) then
        begin
           FRefreshLevel := True;
           FIndexLevel     := 0;
        end;
        {$IFNDEF LEVEL_ONLY}
        if assigned(FMeter1) or assigned(FMeter2) then
        begin
           FRefreshMeter := True;
           FIndexMeter     := 0;
        end;
        if assigned(FOscope1) or assigned(FOscope2) then
        begin
           FRefreshScope := True;
           FIndexScope     := 0;
        end;
        if assigned(FLight1) or assigned(FLight2) then
        begin
           FRefreshLight := True;
           FIndexLight := 0;
        end;
        if assigned(FSpectrum1) or assigned(FSpectrum2) or
           assigned(FSpectrum3) or assigned(FSpectrum4) then
        begin
           FRefreshSpectrum := True;
           FIndexSpectrum  := 0;
        end;
        if assigned(FSpectrogram1) or assigned(FSpectrogram2) then
        begin
           FRefreshSpectrogram := True;
           FIndexSpectrogram1 := 0;
           FIndexSpectrogram2 := 0;
        end;
        {$ENDIF}
     end;
  end;
end;

{== TMMConnector ========================================================}
constructor TMMConnector.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FTimerID    := 0;
   FEnabled    := True;
   FRestoreIdle:= False;
   FAutoConvert:= True;
   FAutoTrigger:= True;
   FTriggerMode:= tmNone;
   FTriggerLevel := 0;
   FSynchronize := True;
   FSpeed      := MAXSPEED;
   FStarted    := False;
   FRunning    := False;
   FPaused     := False;
   FSrcData    := nil;
   FDstData    := nil;
   FDstBufferSize:= 0;
   FRealBufferSize:= 0;
   FIsPCMFormat := False;
   FCanConvert  := False;
   FRefresh     := True;
   FRealTime    := True;

   FLevel1       := nil;
   FLevel2       := nil;
   {$IFNDEF LEVEL_ONLY}
   FMeter1       := nil;
   FMeter2       := nil;
   FOscope1      := nil;
   FOscope2      := nil;
   FLight1       := nil;
   FLight2       := nil;
   FSpectrum1    := nil;
   FSpectrum2    := nil;
   FSpectrum3    := nil;
   FSpectrum4    := nil;
   FSpectrogram1 := nil;
   FSpectrogram2 := nil;
   {$ENDIF}

   FIndexLevel       := 0;
   {$IFNDEF LEVEL_ONLY}
   FIndexMeter       := 0;
   FIndexScope       := 0;
   FIndexLight       := 0;
   FIndexSpectrum    := 0;
   FIndexSpectrogram1:= 0;
   FIndexSpectrogram2:= 0;
   {$ENDIF}

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

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

   if not (csDesigning in ComponentState) then
   begin
      TimeBeginPeriod(1);

      { update the connector list }
      AddConnector(Self);
   end;

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

{-- TMMConnector --------------------------------------------------------}
destructor TMMConnector.Destroy;
var
   Msg: TMsg;

begin
   Stopped;

   if not (csDesigning in ComponentState) then
   begin
      TimeEndPeriod(1);

      { remove pending messages }
      while PeekMessage(Msg, ConnectorWindow, CM_CON_START, CM_CON_AUTOTRIGGER, PM_REMOVE) do;

      { update the connector list }
      RemoveConnector(Self);
   end;

   inherited destroy;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.ChangeDesigning(aValue: Boolean);
begin
   inherited ChangeDesigning(aValue);

   if not (csDesigning in ComponentState) then
   begin
      TimeBeginPeriod(1);

      { update the connector list }
      AddConnector(Self);
   end;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.Notification(aComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(aComponent, Operation);

   if (Operation = opRemove) then
   begin
      if (aComponent = FLevel1) then FLevel1 := nil;
      if (aComponent = FLevel2) then FLevel2 := nil;
      {$IFNDEF LEVEL_ONLY}
      if (aComponent = FMeter1) then FMeter1 := nil;
      if (aComponent = FMeter2) then FMeter2 := nil;
      if (aComponent = FOscope1) then FOscope1 := nil;
      if (aComponent = FOscope2) then FOscope2 := nil;
      if (aComponent = FLight1) then FLight1 := nil;
      if (aComponent = FLight2) then FLight2 := nil;
      if (aComponent = FSpectrum1) then FSpectrum1 := nil;
      if (aComponent = FSpectrum2) then FSpectrum2 := nil;
      if (aComponent = FSpectrum3) then FSpectrum3 := nil;
      if (aComponent = FSpectrum4) then FSpectrum4 := nil;
      if (aComponent = FSpectrogram1) then FSpectrogram1 := nil;
      if (aComponent = FSpectrogram2) then FSpectrogram2 := nil;
      {$ENDIF}
   end;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.UpdateTimer(Enabled: Boolean);
var
{$IFNDEF WIN32}
   TimeCB: TTimeCallBack;
{$ENDIF}
   Time: integer;
begin
   FRefreshLevel      := False;
   {$IFNDEF LEVEL_ONLY}
   FRefreshMeter      := False;
   FRefreshScope      := False;
   FRefreshLight      := False;
   FRefreshSpectrum   := False;
   FRefreshSpectrogram:= False;
   {$ENDIF}

   if (FTimerID <> 0) then
   begin
      MMTimeKillEvent(FTimerID);
      FTimerID := 0;
   end;

   if Enabled then
   begin
      if (BufferSize < 8192) then
          Time := wioBytesToTime(PWaveFormat,BufferSize)
      else
          Time := 25;

      FTimerID := MMTimeSetEvent(Time, False, @TimeCallBack, Longint(Self));
      if (FTimerID = 0) then
         raise EOutOfResources.Create({$IFDEF DELPHI3}SNoTimers{$ELSE}LoadStr(SNoTimers){$ENDIF});
   end;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetEnterIdle(aValue: Boolean);
begin
   ENTER_IDLE_MODE := aValue;
end;

{-- TMMConnector --------------------------------------------------------}
function TMMConnector.GetEnterIdle: Boolean;
begin
   Result := ENTER_IDLE_MODE;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetEnabled(aValue: Boolean);
begin
   if (aValue <> FEnabled) then
   begin
      FEnabled := aValue;
      if not (csDesigning in ComponentState) then
      begin
         if not FEnabled then
         begin
            if FRunning then
            begin
               FRunning := False;
               if FAutoTrigger then dec(LoopStarted);
            end;

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

            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
         else if FStarted 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.SetRealTime(aValue: Boolean);
begin
   if (aValue <> FRealTime) then
   begin
      if isOpen then
         raise EMMConnectorError.Create(LoadResStr(IDS_PROPERTYOPEN));

      FRealTime := aValue;
   end;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetSpeed(aValue: integer);
begin
   if (aValue <> FSpeed) then
   begin
      FSpeed := MinMax(aValue,1,MAXSPEED);
      if not (csDesigning in ComponentState) then UpdateSpeed(Self);
   end;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetTriggerMode(aValue: TMMTriggerMode);
begin
   if (aValue <> FTriggerMode) then
   begin
      FTriggerMode := aValue;
   end;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetTriggerLevel(aValue: integer);
begin
   if (aValue <> FTriggerLevel) then
   begin
      FTriggerLevel := aValue;
   end;
end;

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

   case index of
        0: if (FLevel1 = aValue) or ((aValue <> nil) and (FLevel2 = aValue)) then exit
           else FLevel1 := aValue;
        1: if (FLevel2 = aValue) or ((aValue <> nil) and (FLevel1 = aValue)) then exit
           else FLevel2 := aValue;
   end;
   FRefreshLevel := False;
   if aValue <> nil then SetWaveParams;

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

{$IFNDEF LEVEL_ONLY}
{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetMeter(index: integer; aValue: TMMMeter);
begin
   { bug fix for AXControl under VB }
   if Longint(Self) = Longint(aValue) then exit;

   case index of
        0: if (FMeter1 = aValue) or ((aValue <> nil) and (FMeter2 = aValue)) then exit
           else FMeter1 := aValue;
        1: if (FMeter2 = aValue) or ((aValue <> nil) and (FMeter1 = aValue)) then exit
           else FMeter2 := aValue;
   end;
   FRefreshMeter := False;
   if aValue <> nil then SetWaveParams;
end;

{-- TMMConnector --------------------------------------------------------}
procedure TMMConnector.SetOscope(index: integer; aValue: TMMOscope);
begin