adstatlt.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   ADSTATLT.PAS 4.06                   *}
{*********************************************************}
{* TApdSLController, TApdStatusLight component           *}
{*********************************************************}

{
  Simply adds status triggers to the port which cause lights to change.
  You need to set TApdSLController.Monitoring explicitly at run-time.
  There is a known conflict with most status triggers when faxing, the
  extra status triggers can cause our fax state machines to re-enter.
  Status lines don't have the same meaning with faxing anyway, so don't
  mix faxing and status triggers.
}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$G+,X+,F-,V-,P-,T-,B-,I+}

unit AdStatLt;
  {-Port status light component}

interface

uses
  WinTypes,
  WinProcs,
  SysUtils,
  Classes,
  Controls,
  Graphics,
  Forms,
  Dialogs,
  OoMisc,
  AdExcept,
  AdPort;

const
  adsDefLightDim = 13;

const
  adsDefErrorOffTimeout = 36;
  adsDefBreakOffTimeout = 36;
  adsDefRXDOffTimeout   = 1;
  adsDefTXDOffTimeout   = 1;
  adsDefRingOffTimeout  = 8;
  adsDefLitColor        = clRed;
  adsDefNotLitColor     = clGreen;

type
  TApdCustomStatusLight = class(TApdBaseGraphicControl)
  protected {private}
    {.Z+}
    FGlyph       : TBitmap;
    FLit         : Boolean;
    FLitColor    : TColor;
    FNotLitColor : TColor;
    HaveGlyph    : Boolean;

    procedure SetGlyph(const NewGlyph : TBitmap);
      {-Set the bitmap displayed for the light}
    procedure SetLit(const IsLit : Boolean);
      {-Set whether the light is lit or not}
    procedure SetLitColor(const NewColor : TColor);
      {-Set the color the light is displayed in when it is lit}
    procedure SetNotLitColor(const NewColor : TColor);
      {-Set the color the light is displayed in when it is not lit}

    function GetVersion : string;
    procedure SetVersion(const Value : string);                 

    procedure Paint; override;
    procedure Loaded; override;

  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer); override;
    {.Z-}

    property Version : string                                     
      read GetVersion
      write SetVersion
      stored False;
    property Glyph : TBitmap
      read FGlyph write SetGlyph;
    property Lit : Boolean
      read FLit write SetLit;
    property LitColor : TColor
      read FLitColor write SetLitColor default adsDefLitColor;
    property NotLitColor : TColor
      read FNotLitColor write SetNotLitColor default adsDefNotLitColor;
  end;

  TApdStatusLight = class(TApdCustomStatusLight)
  published
    property Version;                                             
    property Glyph;
    property Lit;
    property LitColor;
    property NotLitColor;
  end;

  TLightSet = class(TPersistent)
  protected {private}
    {.Z+}
    FCTSLight   : TApdCustomStatusLight;
    FDSRLight   : TApdCustomStatusLight;
    FDCDLight   : TApdCustomStatusLight;
    FRINGLight  : TApdCustomStatusLight;
    FTXDLight   : TApdCustomStatusLight;
    FRXDLight   : TApdCustomStatusLight;
    FERRORLight : TApdCustomStatusLight;
    FBREAKLight : TApdCustomStatusLight;

  public
    constructor Create;
    {.Z-}

    procedure InitLights(const ComPort : TApdCustomComPort;
         Monitoring : Boolean);

  published
    property CTSLight : TApdCustomStatusLight
      read FCTSLight write FCTSLight;
    property DSRLight : TApdCustomStatusLight
      read FDSRLight write FDSRLight;
    property DCDLight : TApdCustomStatusLight
      read FDCDLight write FDCDLight;
    property RINGLight : TApdCustomStatusLight
      read FRINGLight write FRINGLight;
    property TXDLight : TApdCustomStatusLight
      read FTXDLight write FTXDLight;
    property RXDLight : TApdCustomStatusLight
      read FRXDLight write FRXDLight;
    property ERRORLight : TApdCustomStatusLight
      read FERRORLight write FERRORLight;
    property BREAKLight : TApdCustomStatusLight
      read FBREAKLight write FBREAKLight;
  end;

  TApdCustomSLController = class(TApdBaseComponent)
  protected {private}
    {.Z+}
    {port stuff}
    FComPort          : TApdCustomComPort;
    FMonitoring       : Boolean;
    MonitoringPending : Boolean;

    {timeouts}
    FErrorOffTimeout  : LongInt;
    FBreakOffTimeout  : LongInt;
    FRXDOffTimeout    : LongInt;
    FTXDOffTimeout    : LongInt;
    FRingOffTimeout   : LongInt;

    {lights}
    FLights           : TLightSet;

    {saved event handlers}
    SaveTriggerAvail  : TTriggerAvailEvent;   {Old data available trigger}
    SaveTriggerStatus : TTriggerStatusEvent;  {Old status trigger handler}
    SaveTriggerTimer  : TTriggerTimerEvent;   {Old timer trigger handler}

    {trigger handles}
    ModemStatMask     : Cardinal;                 {Status bits we want to watch}
    MSTrig            : Integer;              {Modem status indicator trigger}
    ErrorOnTrig       : Integer;              {ERROR indicator turn on trigger}
    BreakOnTrig       : Integer;              {BREAK indicator turn on trigger}
    ErrorOffTrig      : Integer;              {ERROR indicator turn off trigger}
    BreakOffTrig      : Integer;              {BREAK indicator turn off trigger}
    RxdOffTrig        : Integer;              {RXD indicator turn off trigger}
    TxdOnTrig         : Integer;              {TXD indicator turn on trigger}
    TxdOffTrig        : Integer;              {TXD indicator turn off trigger}
    RingOffTrig       : Integer;              {RING indicator turn off trigger}

    function GetHaveCTSLight : Boolean;
    function GetHaveDSRLight : Boolean;
    function GetHaveDCDLight : Boolean;
    function GetHaveRINGLight : Boolean;
    function GetHaveTXDLight : Boolean;
    function GetHaveRXDLight : Boolean;
    function GetHaveERRORLight : Boolean;
    function GetHaveBREAKLight : Boolean;

    procedure SetComPort(const NewPort : TApdCustomComPort);
    procedure SetLights(const NewLights : TLightSet);
    procedure SetMonitoring(const NewMon : Boolean);

    procedure Notification(AComponent : TComponent; Operation: TOperation); override;

    procedure Loaded; override;
    procedure InitTriggers;
      {-Set trigger handles to their default values}
    procedure AddTriggers;
      {-Add triggers to com port}
    procedure RemoveTriggers;
      {-Remove triggers from com port}
    procedure InitLights;
      {-Initialize the default statuses of various modem lights}
    procedure CheckLight(const CurStat : Boolean; const Light : TApdCustomStatusLight);
      {-See if a light has changed and update it if so}

    {replacement trigger handlers}
    procedure StatTriggerAvail(CP : TObject; Count : Word);
    procedure StatTriggerStatus(CP : TObject; TriggerHandle : Word);
    procedure StatTriggerTimer(CP : TObject; TriggerHandle : Word);
    procedure StatPortClose(CP : TObject; Opening : Boolean);

    property HaveCTSLight : Boolean
      read GetHaveCTSLight;
    property HaveDSRLight : Boolean
      read GetHaveDSRLight;
    property HaveDCDLight : Boolean
      read GetHaveDCDLight;
    property HaveRINGLight : Boolean
      read GetHaveRINGLight;
    property HaveTXDLight : Boolean
      read GetHaveTXDLight;
    property HaveRXDLight : Boolean
      read GetHaveRXDLight;
    property HaveERRORLight : Boolean
      read GetHaveERRORLight;
    property HaveBREAKLight : Boolean
      read GetHaveBREAKLight;

  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    {.Z-}

    property Monitoring : Boolean
      read FMonitoring write SetMonitoring;

    {port to monitor}
    property ComPort : TApdCustomComPort
      read FComPort write SetComPort;

    {timeout values}
    property ErrorOffTimeout : LongInt
      read FErrorOffTimeout write FErrorOffTimeout default adsDefErrorOffTimeout;
    property BreakOffTimeout : LongInt
      read FBreakOffTimeout write FBreakOffTimeout default adsDefBreakOffTimeout;
    property RXDOffTimeout : LongInt
      read FRXDOffTimeout write FRXDOffTimeout default adsDefRXDOffTimeout;
    property TXDOffTimeout : LongInt
      read FTXDOffTimeout write FTXDOffTimeout default adsDefTXDOffTimeout;
    property RingOffTimeout : LongInt
      read FRingOffTimeout write FRingOffTimeout default adsDefRingOffTimeout;

    {complete set of lights}
    property Lights : TLightSet
      read FLights write SetLights;
  end;

  TApdSLController = class(TApdCustomSLController)
  published
    property ComPort;
    property ErrorOffTimeout;
    property BreakOffTimeout;
    property RXDOffTimeout;
    property TXDOffTimeout;
    property RingOffTimeout;
    property Lights;
  end;

implementation

{TStatusLight}

  procedure TApdCustomStatusLight.SetGlyph(const NewGlyph : TBitmap);
    {-Set the bitmap displayed for the light}
  begin
    FGlyph.Assign(NewGlyph);
    HaveGlyph := NewGlyph <> nil;

    if HaveGlyph then begin
      Width      := Glyph.Width div 2;
      Height     := Glyph.Height;
    end else begin
      Width      := adsDefLightDim;
      Height     := adsDefLightDim;
    end;

    Refresh;
  end;

  procedure TApdCustomStatusLight.SetLit(const IsLit : Boolean);
    {-Set whether the light is lit or not}
  begin
    if (FLit <> IsLit) then begin
      FLit := IsLit;
      Refresh;
    end;                                                          
  end;

  procedure TApdCustomStatusLight.SetLitColor(const NewColor : TColor);
    {-Set the color the light is displayed in when it is lit}
  begin
    if (NewColor <> FLitColor) then begin
      FLitColor := NewColor;

      if not HaveGlyph and FLit then
        Refresh;
    end;
  end;

  procedure TApdCustomStatusLight.SetNotLitColor(const NewColor : TColor);
    {-Set the color the light is displayed in when it is not lit}
  begin
    if (NewColor <> FNotLitColor) then begin
      FNotLitColor := NewColor;
      if not HaveGlyph and not FLit then
        Refresh;
    end;
  end;

  procedure TApdCustomStatusLight.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
  begin
    if HaveGlyph then begin
      AWidth  := Glyph.Width div 2;
      AHeight := Glyph.Height;
    end;

    inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  end;

  procedure TApdCustomStatusLight.Paint;
  var
    R   : TRect;
    Src : TRect;

  begin
    {get the display dimensions}
    R := Bounds(0, 0, Width, Height);

    {if we have a bitmap, display that}
    if HaveGlyph then begin
      Src := R;

      {if the light is on, use the second half of the bitmap}
      if not Lit then begin
        Inc(Src.Left, Width);
        Inc(Src.Right, Width);
      end;

      {paint the bitmap}
      Canvas.Brush.Color := Parent.Brush.Color;
      Canvas.BrushCopy(R, Glyph, Src, Glyph.Canvas.Pixels[0, 0]); 

    {otherwise, manually draw a square in "lit" or "unlit" color}
    end else begin
      if Lit then
        Canvas.Brush.Color := LitColor
      else
        Canvas.Brush.Color := NotLitColor;
      Canvas.FillRect(R);
      Canvas.Pen.Color := clWhite;
      Canvas.MoveTo(0, 0);
      Canvas.LineTo(Width, 0);
      Canvas.MoveTo(0, 0);
      Canvas.LineTo(0, Height);
      Canvas.Pen.Color := clDkGray;
      Canvas.MoveTo(Width - 1, 1);
      Canvas.LineTo(Width - 1, Height);
      Canvas.MoveTo(1, Height - 1);
      Canvas.LineTo(Width, Height - 1);
    end;
  end;

  procedure TApdCustomStatusLight.Loaded;
  begin
    inherited Loaded;

    HaveGlyph := (Glyph.Handle <> 0);
  end;

  constructor TApdCustomStatusLight.Create(AOwner : TComponent);
  begin
    inherited Create(AOwner);

    FGlyph       := TBitmap.Create;
    FLit         := False;
    FLitColor    := adsDefLitColor;
    FNotLitColor := adsDefNotLitColor;
    Width        := adsDefLightDim;
    Height       := adsDefLightDim;

    HaveGlyph := False;
  end;

  destructor TApdCustomStatusLight.Destroy;
  begin
    FGlyph.Free;

    inherited Destroy;
  end;

  function TApdCustomStatusLight.GetVersion : string;
  begin
    Result := ApVersionStr;
  end;

  procedure TApdCustomStatusLight.SetVersion(const Value : string);
  begin
  end;

{TLightSet}

  constructor TLightSet.Create;
  begin
    CTSLight   := nil;
    DSRLight   := nil;
    DCDLight   := nil;