adstatlt.pas

测试用例

    RINGLight  := nil;
    TXDLight   := nil;
    RXDLight   := nil;
    ERRORLight := nil;
    BREAKLight := nil;
  end;

  procedure TLightSet.InitLights(const ComPort : TApdCustomComPort;
                                       Monitoring : Boolean);        
  begin
    if Assigned(FCTSLight) then
      CTSLight.Lit := False;
    if Assigned(FDSRLight) then
      DSRLight.Lit := False;
    if Assigned(FDCDLight) then
      DCDLight.Lit := False;
    if Assigned(FRINGLight) then
      RINGLight.Lit := False;
    if Assigned(FTXDLight) then
      TXDLight.Lit := False;
    if Assigned(FRXDLight) then
      RXDLight.Lit := False;
    if Assigned(FERRORLight) then
      ERRORLight.Lit := False;
    if Assigned(FBREAKLight) then
      BREAKLight.Lit := False;

    if Assigned(ComPort) and Monitoring then begin                   
      if Assigned(FCTSLight) then
        CTSLight.Lit := ComPort.CTS;
      if Assigned(FDSRLight) then
        DSRLight.Lit := ComPort.DSR;
      if Assigned(FDCDLight) then
        DCDLight.Lit := ComPort.DCD;
    end;
  end;

{TSLController}

  function TApdCustomSLController.GetHaveCTSLight : Boolean;
  begin
    GetHaveCTSLight := Assigned(Lights.FCTSLight);
  end;

  function TApdCustomSLController.GetHaveDSRLight : Boolean;
  begin
    GetHaveDSRLight := Assigned(Lights.FDSRLight);
  end;

  function TApdCustomSLController.GetHaveDCDLight : Boolean;
  begin
    GetHaveDCDLight := Assigned(Lights.FDCDLight);
  end;

  function TApdCustomSLController.GetHaveRINGLight : Boolean;
  begin
    GetHaveRINGLight := Assigned(Lights.FRINGLight);
  end;

  function TApdCustomSLController.GetHaveTXDLight : Boolean;
  begin
    GetHaveTXDLight := Assigned(Lights.FTXDLight);
  end;

  function TApdCustomSLController.GetHaveRXDLight : Boolean;
  begin
    GetHaveRXDLight := Assigned(Lights.FRXDLight);
  end;

  function TApdCustomSLController.GetHaveERRORLight : Boolean;
  begin
    GetHaveERRORLight := Assigned(Lights.FERRORLight);
  end;

  function TApdCustomSLController.GetHaveBREAKLight : Boolean;
  begin
    GetHaveBREAKLight := Assigned(Lights.FBREAKLight);
  end;

  procedure TApdCustomSLController.SetComPort(const NewPort : TApdCustomComPort);
  var
    WasMonitoring : Boolean;

  begin
    if (NewPort = FComPort) then
      Exit;

    if Assigned(FComPort) then
      FComPort.DeregisterUserCallback(StatPortClose);

    WasMonitoring := Monitoring;
    Monitoring    := False;
    FComPort      := NewPort;
    Monitoring    := WasMonitoring;

    if Assigned(FComPort) then
      FComPort.RegisterUserCallback(StatPortClose);
  end;

  procedure TApdCustomSLController.SetLights(const NewLights : TLightSet);
  begin
    FLights := NewLights;
  end;

  procedure TApdCustomSLController.SetMonitoring(const NewMon : Boolean);
  begin
    if (csDesigning in ComponentState) or
      (csLoading in ComponentState) or
      (FMonitoring = NewMon) then
      Exit;

    if not Assigned(FComPort) then
      raise EPortNotAssigned.Create(ecPortNotAssigned, False);

    if not ComPort.Open then begin
      MonitoringPending := NewMon;
      if MonitoringPending then
        Exit;                                                         
    end;

    FMonitoring := NewMon;

    if FMonitoring then begin
      SaveTriggerAvail        := ComPort.OnTriggerAvail;
      SaveTriggerStatus       := ComPort.OnTriggerStatus;
      SaveTriggerTimer        := ComPort.OnTriggerTimer;
      ComPort.OnTriggerAvail  := StatTriggerAvail;
      ComPort.OnTriggerStatus := StatTriggerStatus;
      ComPort.OnTriggerTimer  := StatTriggerTimer;

      AddTriggers;
      InitLights;
    end else begin
      ComPort.OnTriggerAvail  := SaveTriggerAvail;
      ComPort.OnTriggerStatus := SaveTriggerStatus;
      ComPort.OnTriggerTimer  := SaveTriggerTimer;

      RemoveTriggers;
      InitLights;                                                  
    end;
  end;

  procedure TApdCustomSLController.Notification(AComponent : TComponent; Operation: TOperation);
  begin
    inherited Notification(AComponent, Operation);

    if (Operation = opRemove) then begin
      if (AComponent = FComPort) then begin
        Monitoring := False;
        ComPort    := nil;
      end else if (AComponent = Lights.CTSLight) then
        Lights.CTSLight := nil
      else if (AComponent = Lights.DSRLight) then
        Lights.DSRLight := nil
      else if (AComponent = Lights.DCDLight) then
        Lights.DCDLight := nil
      else if (AComponent = Lights.RINGLight) then
        Lights.RINGLight := nil
      else if (AComponent = Lights.TXDLight) then
        Lights.TXDLight := nil
      else if (AComponent = Lights.RXDLight) then
        Lights.RXDLight := nil
      else if (AComponent = Lights.ERRORLight) then
        Lights.ERRORLight := nil
      else if (AComponent = Lights.BREAKLight) then
        Lights.BREAKLight := nil;
    end else if (Operation = opInsert) then
      if not Assigned(FComPort) and (AComponent is TApdCustomComPort) then
        ComPort := TApdCustomComPort(AComponent);
  end;

  procedure TApdCustomSLController.Loaded;
  begin
    inherited Loaded;

    if Assigned(FComPort) then
      FComPort.RegisterUserCallback(StatPortClose);
  end;

  procedure TApdCustomSLController.InitTriggers;
    {-Set trigger handles to their default values}
  begin
    {default trigger handles}
    ModemStatMask := 0;
    MSTrig        := 0;
    ErrorOnTrig   := 0;
    BreakOnTrig   := 0;
    ErrorOffTrig  := 0;
    BreakOffTrig  := 0;
    RxdOffTrig    := 0;
    TxdOnTrig     := 0;
    TxdOffTrig    := 0;
    RingOffTrig   := 0;
  end;

  procedure TApdCustomSLController.AddTriggers;
    {-Add triggers to com port}
  begin
    InitTriggers;

    if Assigned(FComPort) then begin
      try
        if HaveCTSLight or HaveDSRLight or HaveDCDLight or HaveRingLight then begin
          MSTrig := ComPort.AddStatusTrigger(stModem);
          if HaveRingLight then
            RingOffTrig := ComPort.AddTimerTrigger;
        end;

        if HaveErrorLight then begin
          ErrorOnTrig  := ComPort.AddStatusTrigger(stLine);
          ErrorOffTrig := ComPort.AddTimerTrigger;
        end;

        if HaveBreakLight then begin
          BreakOnTrig  := ComPort.AddStatusTrigger(stLine);
          BreakOffTrig := ComPort.AddTimerTrigger;
        end;

        if HaveRXDLight then
          RXDOffTrig := ComPort.AddTimerTrigger;

        if HaveTXDLight then begin
          TXDOnTrig   := ComPort.AddStatusTrigger(stOutSent);
          TXDOffTrig := ComPort.AddTimerTrigger;
        end;

        ModemStatMask := 0;
        if HaveCTSLight then
          ModemStatMask := ModemStatMask or msCTSDelta;
        if HaveDSRLight then
          ModemStatMask := ModemStatMask or msDSRDelta;
        if HaveDCDLight then
          ModemStatMask := ModemStatMask or msDCDDelta;
        if HaveRINGLight then
          ModemStatMask := ModemStatMask or msRINGDelta;

        if HaveCTSLight or HaveDSRLight or HaveDCDLight or HaveRINGLight then
          ComPort.SetStatusTrigger(MSTrig, ModemStatMask, True);

        if HaveERRORLight then
          ComPort.SetStatusTrigger(ErrorOnTrig, lsOverrun or lsParity or lsFraming, True);
        if HaveBreakLight then
          ComPort.SetStatusTrigger(BreakOnTrig, lsBreak, True);
        if HaveTXDLight then
          ComPort.SetStatusTrigger(TXDOnTrig, 0, True);

      except
        ModemStatMask := 0;
        RemoveTriggers;
        raise;
      end;
    end;
  end;

  procedure TApdCustomSLController.RemoveTriggers;
    {-Remove triggers from com port}
  begin
    if Assigned(FComPort) then begin
      try
        if HaveCTSLight or HaveDSRLight or HaveDCDLight or HaveRingLight then begin
          ComPort.RemoveTrigger(MSTrig);
          if HaveRingLight then
            ComPort.RemoveTrigger(RingOffTrig);
        end;

        if HaveErrorLight then begin
          ComPort.RemoveTrigger(ErrorOnTrig);
          ComPort.RemoveTrigger(ErrorOffTrig);
        end;

        if HaveBreakLight then begin
          ComPort.RemoveTrigger(BreakOnTrig);
          ComPort.RemoveTrigger(BreakOffTrig);
        end;

        if HaveRXDLight then
          ComPort.RemoveTrigger(RXDOffTrig);

        if HaveTXDLight then begin
          ComPort.RemoveTrigger(TXDOnTrig);
          ComPort.RemoveTrigger(TXDOffTrig);
        end;

      finally
        InitTriggers;
      end;
    end;
  end;

  procedure TApdCustomSLController.InitLights;
    {-Initialize the default statuses of various modem lights}
  begin
    Lights.InitLights(FComPort, Monitoring);
  end;

  procedure TApdCustomSLController.CheckLight(const CurStat : Boolean; const Light : TApdCustomStatusLight);
    {-See if a light has changed and update it if so}
  begin
    if CurStat <> Light.Lit then
      Light.Lit := CurStat;
  end;

  procedure TApdCustomSLController.StatTriggerAvail(CP : TObject; Count : Word);
  begin
    if Assigned(FComPort) then begin
      if HaveRXDLight and not Lights.RXDLight.Lit then begin
        Lights.RXDLight.Lit := True;
        ComPort.SetTimerTrigger(RXDOffTrig, RXDOffTimeout, True);
      end;

      if Assigned(SaveTriggerAvail) then
        SaveTriggerAvail(CP, Count);
    end;
  end;

  procedure TApdCustomSLController.StatTriggerStatus(CP : TObject; TriggerHandle : Word);
  begin
    if Assigned(FComPort) then begin
      if (TriggerHandle = MSTrig) then begin
        if HaveDCDLight then
          CheckLight(ComPort.DCD, Lights.DCDLight);
        if HaveCTSLight then
          CheckLight(ComPort.CTS, Lights.CTSLight);
        if HaveDSRLight then
          CheckLight(ComPort.DSR, Lights.DSRLight);

        if HaveRingLight then
          if ComPort.DeltaRI and not Lights.RINGLight.Lit then begin
            Lights.RINGLight.Lit := True;
            ComPort.SetTimerTrigger(RingOffTrig, RingOffTimeout, True);
          end;

        ComPort.SetStatusTrigger(MSTrig, ModemStatMask, True);
      end else if (TriggerHandle = ErrorOnTrig) then begin
        Lights.ErrorLight.Lit := True;
        ComPort.SetTimerTrigger(ErrorOffTrig, ErrorOffTimeout, True);
        if (ComPort.LineError <> 0) then ;
      end else if (TriggerHandle = BreakOnTrig) then begin
        Lights.BreakLight.Lit := True;
        ComPort.SetTimerTrigger(BreakOffTrig, BreakOffTimeout, True);
        if ComPort.LineBreak then ;
      end else if (TriggerHandle = TXDOnTrig) then begin
        Lights.TXDLight.Lit := True;
        ComPort.SetTimerTrigger(TXDOffTrig, TXDOffTimeout, True);
      end;

      if Assigned(SaveTriggerStatus) then
        SaveTriggerStatus(CP, TriggerHandle);
    end;
  end;

  procedure TApdCustomSLController.StatTriggerTimer(CP : TObject; TriggerHandle : Word);
  begin
    if Assigned(FComport) then begin
      if (TriggerHandle = ErrorOffTrig) then begin
        Lights.ErrorLight.Lit := False;
        ComPort.SetStatusTrigger(ErrorOnTrig, lsOverrun or lsParity or lsFraming, True);
      end else if (TriggerHandle = BreakOffTrig) then begin
        Lights.BreakLight.Lit := False;
        ComPort.SetStatusTrigger(BreakOnTrig, lsBreak, True);
      end else if (TriggerHandle = RXDOffTrig) then
        if (ComPort.InBuffUsed = 0) then
          Lights.RXDLight.Lit := False
        else
          ComPort.SetTimerTrigger(RXDOffTrig, RXDOffTimeout, True)
      else if (TriggerHandle = TXDOffTrig) then
        if (ComPort.OutBuffUsed = 0) then begin
          Lights.TXDLight.Lit := False;
          ComPort.SetStatusTrigger(TXDOnTrig, 0, True);
        end else
          ComPort.SetTimerTrigger(TXDOffTrig, TXDOffTimeout, True)
      else if (TriggerHandle = RingOffTrig) then
        Lights.RINGLight.Lit := False;

      if Assigned(SaveTriggerTimer) then
        SaveTriggerTimer(CP, TriggerHandle);
    end;
  end;

  procedure TApdCustomSLController.StatPortClose(CP : TObject; Opening : Boolean);
  begin
    if (csDesigning in ComponentState) then
      Exit;

    if Opening then begin
      if MonitoringPending then begin
        MonitoringPending := False;
        Monitoring        := True;
      end;
    end else begin
      MonitoringPending := Monitoring;
      Monitoring := False;
    end;
  end;

  constructor TApdCustomSLController.Create(AOwner : TComponent);
  var
    I : Cardinal;
  begin
    inherited Create(AOwner);

    FMonitoring       := False;
    MonitoringPending := False;

    {search our owner for a com port}
    if Assigned(AOwner) and (AOwner.ComponentCount > 0) then
      for I := 0 to Pred(AOwner.ComponentCount) do
        if AOwner.Components[I] is TApdCustomComPort then begin
          FComPort := TApdCustomComPort(AOwner.Components[I]);
          Break;
        end;

    {set default timeouts}
    FErrorOffTimeout := adsDefErrorOffTimeout;
    FBreakOffTimeout := adsDefBreakOffTimeout;
    FRXDOffTimeout   := adsDefRXDOffTimeout;
    FTXDOffTimeout   := adsDefTXDOffTimeout;
    FRingOffTimeout  := adsDefRingOffTimeout;

    {set lights}
    FLights := TLightSet.Create;

    {set saved event handlers}
    SaveTriggerAvail  := nil;
    SaveTriggerStatus := nil;
    SaveTriggerTimer  := nil;

    InitTriggers;
  end;

  destructor TApdCustomSLController.Destroy;
  begin
    Monitoring := False;
    FLights.Free;

    inherited Destroy;
  end;

end.