(******************************************************
 * ComPort Library ver. 3.0                           *
 *   for Delphi 3, 4, 5, 6, 7 and                     *
 *   C++ Builder 3, 4, 5, 6                           *
 * written by Dejan Crnila, 1998 - 2002               *
 * maintained by Lars B. Dybdahl, 2003                *
 * Homepage: http://comport.sf.net/                   *
 *                                                    *
 * Fixed up for Delphi 2009 by W.Postma.  Oct 2008    *
 * More like completely rewritten, actually.          *
 *****************************************************)

{ The visual com-port-related controls, and components used in
  communications setup dialog boxes, like the Terminal,
  etc, are implemented in this unit.
}
unit CPortCtl;

{$I CPort.inc}

interface

uses
  Classes, SysUtils, Controls, StdCtrls, ExtCtrls, Forms,
  Messages, Graphics, Windows, CPort, CPortEsc, CPortTypes;

const
  RxSanityLimit = 1024;

type
  // property types
  TComProperty = (cpNone, cpPort, cpBaudRate, cpDataBits, cpStopBits,
    cpParity, cpFlowControl);

  // assistant class for TComComboBox, TComRadioGroup controls
  TComSelect = class
  private
    FPort: TPort;
    FBaudRate: TBaudRate;
    FDataBits: TDataBits;
    FStopBits: TStopBits;
    FParity: TParityBits;
    FFlowControl: TFlowControl;
    FItems: TStrings;
    FComProperty: TComProperty;
    FComPort: TCustomComPort;
    FAutoApply: Boolean;
  private
    procedure SetComProperty(const Value: TComProperty);
  public
    procedure SelectPort;
    procedure SelectBaudRate;
    procedure SelectParity;
    procedure SelectStopBits;
    procedure SelectDataBits;
    procedure SelectFlowControl;
    procedure Change(const Text: string);
    procedure UpdateSettings(var ItemIndex: Integer);
    procedure ApplySettings;
    property Items: TStrings read FItems write FItems;
    property ComProperty: TComProperty read FComProperty write SetComProperty;
    property ComPort: TCustomComPort read FComPort write FComPort;
    property AutoApply: Boolean read FAutoApply write FAutoApply;
  end;

  // combo control for selecting port properties
  TComComboBox = class(TCustomComboBox)
  private
    FComSelect: TComSelect;
    function GetAutoApply: Boolean;
    function GetComPort: TCustomComPort;
    function GetComProperty: TComProperty;
    function GetText: string;
    procedure SetAutoApply(const Value: Boolean);
    procedure SetComPort(const Value: TCustomComPort);
    procedure SetComProperty(const Value: TComProperty);
    procedure SetText(const Value: string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ApplySettings;
    procedure UpdateSettings;
  published
    property ComPort: TCustomComPort read GetComPort write SetComPort;
    property ComProperty: TComProperty read GetComProperty write SetComProperty default cpNone;
    property AutoApply: Boolean read GetAutoApply write SetAutoApply default False;
    property Text: string read GetText write SetText;
    property Style;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property ItemIndex;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
{$IFDEF DELPHI_4_OR_HIGHER}
    property Anchors;
    property BiDiMode;
    property CharCase;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
{$ENDIF}
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDrag;
{$IFDEF DELPHI_4_OR_HIGHER}
    property OnEndDock;
    property OnStartDock;
{$ENDIF}
{$IFDEF DELPHI_5_OR_HIGHER}
    property OnContextPopup;
{$ENDIF}
  end;

  // radio group control for selecting port properties
  TComRadioGroup = class(TCustomRadioGroup)
  private
    FComSelect: TComSelect;
    FOldIndex: Integer;
    function GetAutoApply: Boolean;
    function GetComPort: TCustomComPort;
    function GetComProperty: TComProperty;
    procedure SetAutoApply(const Value: Boolean);
    procedure SetComPort(const Value: TCustomComPort);
    procedure SetComProperty(const Value: TComProperty);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ApplySettings;
    procedure UpdateSettings;
  published
    property ComPort: TCustomComPort read GetComPort write SetComPort;
    property ComProperty: TComProperty read GetComProperty write SetComProperty default cpNone;
    property AutoApply: Boolean read GetAutoApply write SetAutoApply default False;
    property Align;
    property Caption;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ItemIndex;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
{$IFDEF DELPHI_4_OR_HIGHER}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DockSite;
    property DragKind;
    property ParentBiDiMode;
{$ENDIF}
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
    property OnEnter;
    property OnExit;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseDown;
{$IFDEF DELPHI_4_OR_HIGHER}
    property OnEndDock;
    property OnStartDock;
    property OnGetSiteInfo;
    property OnDockDrop;
    property OnDockOver;
    property OnUnDock;
{$ENDIF}
{$IFDEF DELPHI_5_OR_HIGHER}
    property OnContextPopup;
{$ENDIF}
  end;

  // property types

  TLedKind = (lkRedLight, lkGreenLight, lkBlueLight, lkYellowLight,
    lkPurpleLight, lkBulb, lkCustom);
  TComLedSignal = (lsConn, lsCTS, lsDSR, lsRLSD, lsRing, lsRx, lsTx);
  TLedState = (lsOff, lsOn);

  TLedStateEvent = procedure(Sender: TObject; AState: TLedState) of object;

  //TLedBitmap = Graphics.TBitmap; { type of alias doesn't work when wrapping for C++Builder.}

  TLedBitmap = class (Graphics.TBitmap)
      // WE HAVE TO subclass it, even though we don't do anything extra with it.
  end;

  TComLedGlyphs = array[TLedState] of TLedBitmap;  

  // led control that shows the state of serial signals
  TComLed = class(TGraphicControl)
  private
    FComPort: TComPort;
    FLedSignal: TComLedSignal;
    FKind: TLedKind;
    FState: TLedState;
    FPendingState : TLedState; // what will LEd be after timer expires.
    FOnChange: TLedStateEvent;
    FGlyphs: TComLedGlyphs;
    FComLink: TComLink;
    FRingDuration:Integer;
    FTimer: TTimer;
    FPendingInvalidate:Boolean;


    function GetGlyph(const Index: Integer): TLedBitmap;
    procedure SetComPort(const Value: TComPort);
    procedure SetKind(const Value: TLedKind);
    procedure SetState(const Value: TLedState);
    procedure SetLedSignal(const Value: TComLedSignal);
    procedure SetGlyph(const Index: Integer; const Value: TLedBitmap);

    function StoredGlyph(const Index: Integer): Boolean;
    procedure SelectLedBitmap(const LedKind: TLedKind);
    procedure SetStateInternal(const Value: TLedState);
    function CalcBitmapPos: TPoint;
    function BitmapToDraw: TLedBitmap;
    procedure BitmapNeeded;
    procedure SignalChange(Sender: TObject; OnOff: Boolean);
    procedure RingDetect(Sender: TObject);
    procedure DoTimer(Sender: TObject);
    function IsStateOn: Boolean;
  protected
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoChange(AState: TLedState); dynamic;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ComPort: TComPort read FComPort write SetComPort;
    property LedSignal: TComLedSignal read FLedSignal write SetLedSignal;
    // kind property must be published before GlyphOn, GlyphOff
    property Kind: TLedKind read FKind write SetKind;
    property GlyphOn: TLedBitmap index 0
      read GetGlyph write SetGlyph stored StoredGlyph;
    property GlyphOff: TLedBitmap index 1
      read GetGlyph write SetGlyph stored StoredGlyph;
    property State: TLedState read FState write SetState default lsOff;
    property RingDuration: Integer read FRingDuration write FRingDuration default 1000;
    property Align;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
{$IFDEF DELPHI_4_OR_HIGHER}
    property Anchors;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
{$ENDIF}
    property OnChange: TLedStateEvent read FOnChange write FOnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
{$IFDEF DELPHI_4_OR_HIGHER}
    property OnEndDock;
    property OnResize;
    property OnStartDock;
{$ENDIF}
{$IFDEF DELPHI_5_OR_HIGHER}
    property OnContextPopup;
{$ENDIF}
  end;

  TCustomComTerminal = class;  // forward declaration

  // terminal Character
  TComTermChar = record
    Ch: Char;
    FrontColor: TColor;
    BackColor: TColor;
    Underline: Boolean;
  end;

  // buffer which holds terminal screen data
  TComTermBuffer = class
  private
    FBuffer: Pointer;
    FTabs: Pointer;
    FOwner: TCustomComTerminal;
  public
    constructor Create(AOwner: TCustomComTerminal);
    destructor Destroy; override;
    procedure Init;
    procedure SetChar(Column, Row: Integer; TermChar: TComTermChar);
    function GetChar(Column, Row: Integer): TComTermChar;
    procedure SetTab(Column: Integer; Put: Boolean);
    function GetTab(Column: Integer): Boolean;
    function NextTab(Column: Integer): Integer;
    procedure ClearAllTabs;
    procedure ScrollDown;
    procedure ScrollUp;
    procedure EraseScreen(Column, Row: Integer);
    procedure EraseLine(Column, Row: Integer);
    function GetLineLength(Line: Integer): Integer;
    function GetLastLine: Integer;
  end;

  // terminal types
  TTermEmulation = (teVT100orANSI, teVT52, teNone);
  TTermCaret = (tcBlock, tcUnderline, tcNone);
  TAdvanceCaret = (acChar, acReturn, acLineFeed, acReverseLineFeed,
    acTab, acBackspace);
  TArrowKeys = (akTerminal, akWindows);
  TTermAttributes = record
    FrontColor: TColor;
    BackColor: TColor;
    Invert: Boolean;
    AltIntensity: Boolean;
    Underline: Boolean;
  end;
  TTermMode = record
    Keys: TArrowKeys;
  end;

  TEscapeEvent = procedure(Sender: TObject; var EscapeCodes: TEscapeCodes) of object;
  TUnhandledEvent = procedure(Sender: TObject; Code: TEscapeCode; Data: string) of object;
  TStrRecvEvent = procedure(Sender: TObject; var Str: string) of object;
  TChScreenEvent = procedure(Sender: TObject; Ch: Char) of object;

  // communication terminal control
  TCustomComTerminal = class(TCustomControl)
  private
    FComLink: TComLink;
    FComPort: TCustomComPort;
    FBorderStyle: TBorderStyle;
    FScrollBars: TScrollStyle;
    FArrowKeys: TArrowKeys;
    FWantTab: Boolean;
    FColumns: Integer;
    FRows: Integer;
    FAltColor: TColor;
    FLocalEcho: Boolean;
    FSendLF: Boolean;
    FAppendLF: Boolean;
    FForce7Bit: Boolean;
    FWrapLines: Boolean;
    FSmoothScroll: Boolean;
    FFontHeight: Integer;
    FFontWidth: Integer;
    FEmulation: TTermEmulation;
    FCaret: TTermCaret;
    FCaretPos: TPoint;
    FSaveCaret: TPoint;
    FCaretCreated: Boolean;
    FTopLeft: TPoint;
    FCaretHeight: Integer;
    FSaveAttr: TTermAttributes;
    FBuffer: TComTermBuffer;
    FEscapeCodes: TEscapeCodes;
    FTermAttr: TTermAttributes;
    FTermMode: TTermMode;
    FOnChar: TChScreenEvent;
    FOnGetEscapeCodes: TEscapeEvent;
    FOnUnhandledCode: TUnhandledEvent;
    FOnStrRecieved: TStrRecvEvent;
    procedure AdvanceCaret(Kind: TAdvanceCaret);
    function CalculateMetrics: Boolean;
    procedure CreateEscapeCodes;
    procedure CreateTerminalCaret;
    procedure DrawChar(AColumn, ARow: Integer; Ch: TComTermChar);
    function GetCharAttr: TComTermChar;
    function GetConnected: Boolean;
    procedure HideCaret;
    procedure InitCaret;
    procedure InvalidatePortion(ARect: TRect);
    procedure ModifyScrollBar(ScrollBar, ScrollCode, Pos: Integer);
    procedure SetAltColor(const Value: TColor);
    procedure SetBorderStyle(const Value: TBorderStyle);
    procedure SetColumns(const Value: Integer);
    procedure SetComPort(const Value: TCustomComPort);
    procedure SetConnected(const Value: Boolean);
    procedure SetEmulation(const Value: TTermEmulation);
    procedure SetRows(const Value: Integer);
    procedure SetScrollBars(const Value: TScrollStyle);
    procedure SetCaret(const Value: TTermCaret);
    procedure SetAttributes(AParams: TStrings);
    procedure SetMode(AParams: TStrings; OnOff: Boolean);
    procedure ShowCaret;
    procedure StringReceived(Str: string);
    procedure PaintTerminal(Rect: TRect);
    procedure PaintDesign;
    procedure PutChar(Ch: Char);
    function PutEscapeCode(ACode: TEscapeCode; AParams: TStrings): Boolean;
    procedure RestoreAttr;
    procedure RestoreCaretPos;
    procedure RxBuf(Sender: TObject; const Buffer:TCPortBytes; Count: Integer);
    procedure SaveAttr;
    procedure SaveCaretPos;
    procedure SendChar(Ch: Char);
    procedure SendCode(Code: TEscapeCode; AParams: TStrings);
    procedure SendCodeNoEcho(Code: TEscapeCode; AParams: TStrings);
    procedure PerformTest(ACh: Char);
    procedure UpdateScrollPos;
    procedure UpdateScrollRange;
  protected
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
{$IFDEF DELPHI_4_OR_HIGHER}
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
{$ENDIF}
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure DoChar(Ch: Char); dynamic;
    procedure DoGetEscapeCodes(var EscapeCodes: TEscapeCodes); dynamic;
    procedure DoStrRecieved(var Str: string); dynamic;
    procedure DoUnhandledCode(Code: TEscapeCode; Data: string); dynamic;
  public

    procedure SetTermAttrColors( FrontColor,BackColor:TColor; AltIntensity,Invert:Boolean); //WARREN ADDED


    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ClearScreen;
    procedure MoveCaret(AColumn, ARow: Integer);
    procedure Write(const Buffer:TCPortBytes; Size: Integer);
    procedure WriteStr(const Str: string);
    procedure WriteEscCode(ACode: TEscapeCode; AParams: TStrings);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure SelectFont;
    procedure ShowSetupDialog;

    property CaretPos: TPoint read FCaretPos;

    property AltColor: TColor read FAltColor write SetAltColor default $00A6A6A6;
    property AppendLF: Boolean read FAppendLF write FAppendLF default False;
    property ArrowKeys: TArrowKeys read FArrowKeys write FArrowKeys default akTerminal;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Caret: TTermCaret read FCaret write SetCaret default tcBlock;
    property Connected: Boolean read GetConnected write SetConnected stored False;
    property ComPort: TCustomComPort read FComPort write SetComPort;
    property Columns: Integer read FColumns write SetColumns default 80;
    property Emulation: TTermEmulation read FEmulation write SetEmulation;
    property EscapeCodes: TEscapeCodes read FEscapeCodes;
    property Force7Bit: Boolean read FForce7Bit write FForce7Bit default False;
    property LocalEcho: Boolean read FLocalEcho write FLocalEcho default False;
    property SendLF: Boolean read FSendLF write FSendLF default False;
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
    property SmoothScroll: Boolean read FSmoothScroll write FSmoothScroll default False;
    property Rows: Integer read FRows write SetRows default 24;
    property WantTab: Boolean read FWantTab write FWantTab default False;
    property WrapLines: Boolean read FWrapLines write FWrapLines default False;
    property OnChar: TChScreenEvent read FOnChar write FOnChar;
    property OnGetEscapeCodes: TEscapeEvent
      read FOnGetEscapeCodes write FOnGetEscapeCodes;
    property OnStrRecieved: TStrRecvEvent
      read FOnStrRecieved write FOnStrRecieved;
    property OnUnhandledCode: TUnhandledEvent
      read FOnUnhandledCode write FOnUnhandledCode;
  end;

  // publish properties
  TComTerminal = class(TCustomComTerminal)
  published
    property Align;
    property AltColor;
    property AppendLF;
    property ArrowKeys;
    property BorderStyle;
    property Color;
    property Columns;
    property ComPort;
    property Connected;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Emulation;
    property Enabled;
    property Font;
    property Force7Bit;
    property Hint;
    property ImeMode;
    property ImeName;
    property LocalEcho;
    property ParentCtl3D;
    property ParentShowHint;
    property PopupMenu;
    property Rows;
    property ScrollBars;
    property SendLF;
    property ShowHint;
    property SmoothScroll;
    property TabOrder;
    property TabStop default True;
    property Caret;
    property Visible;
    property WantTab;
    property WrapLines;
{$IFDEF DELPHI_4_OR_HIGHER}
    property Anchors;
    property AutoSize;
    property Constraints;
    property DragKind;
{$ENDIF}
    property OnChar;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetEscapeCodes;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnStrRecieved;
    property OnUnhandledCode;
{$IFDEF DELPHI_4_OR_HIGHER}
    property OnCanResize;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnEndDock;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnStartDock;
    property OnUnDock;
{$ENDIF}
{$IFDEF DELPHI_5_OR_HIGHER}
    property OnContextPopup;
{$ENDIF}
  end;

var
  ComTerminalFont: TFont; // default terminal font

implementation

{$R CPortImg.res}



uses
  Dialogs, CPortTrmSet;

(*****************************************
 * auxilary functions                    *
 *****************************************)

function Min(A, B: Integer): Integer;
begin
  if A < B then
    Result := A
  else
    Result := B;
end;

function Max(A, B: Integer): Integer;
begin
  if A > B then
    Result := A
  else
    Result := B;
end;

(*****************************************
 * TComSelect class                      *
 *****************************************)

// select baud rate property
procedure TComSelect.SelectBaudRate;
var
  I: TBaudRate;
begin
  Items.Clear;
  for I := Low(TBaudRate) to High(TBaudRate) do
    Items.Add(BaudRateToStr(I));
end;

// select port property
procedure TComSelect.SelectPort;
begin
  Items.Clear;
  EnumComPorts(Items);
end;

// select data bits property
procedure TComSelect.SelectDataBits;
var
  I: TDataBits;
begin
  Items.Clear;
  for I := Low(TDataBits) to High(TDataBits) do
    Items.Add(DataBitsToStr(I));
end;

// select parity property
procedure TComSelect.SelectParity;
var
  I: TParityBits;
begin
  Items.Clear;
  for I := Low(TParityBits) to High(TParityBits) do
    Items.Add(ParityToStr(I));
end;

// select stop bits property
procedure TComSelect.SelectStopBits;
var
  I: TStopBits;
begin
  Items.Clear;
  for I := Low(TStopBits) to High(TStopBits) do
    Items.Add(StopBitsToStr(I));
end;

// select flow control property
procedure TComSelect.SelectFlowControl;
var
  I: TFlowControl;
begin
  Items.Clear;
  for I := Low(TFlowControl) to High(TFlowControl) do
    Items.Add(FlowControlToStr(I));
end;

// set property port settings for selecting
procedure TComSelect.SetComProperty(const Value: TComProperty);
begin
  FComProperty := Value;
  case FComProperty of
    cpPort: SelectPort;
    cpBaudRate: SelectBaudRate;
    cpDataBits: SelectDataBits;
    cpStopBits: SelectStopBits;
    cpParity: SelectParity;
    cpFlowControl: SelectFlowControl;
  else
    Items.Clear;
  end;
end;

// set selected setting
procedure TComSelect.Change(const Text: string);
begin
  case FComProperty of
    cpPort: FPort := Text;
    cpBaudRate: FBaudRate := StrToBaudRate(Text);
    cpDataBits: FDataBits := StrToDataBits(Text);
    cpStopBits: FStopBits := StrToStopBits(Text);
    cpParity: FParity := StrToParity(Text);
    cpFlowControl: FFlowControl := StrToFlowControl(Text);
  end;
  if FAutoApply then
    ApplySettings;
end;

// apply settings to TCustomComPort
procedure TComSelect.ApplySettings;
begin
  if FComPort <> nil then
  begin
    with FComPort do
    begin
      case FComProperty of
        cpPort: Port := FPort;
        cpBaudRate: BaudRate := FBaudRate;
        cpDataBits: DataBits := FDataBits;
        cpStopBits: StopBits := FStopBits;
        cpParity: Parity.Bits := FParity;
        cpFlowControl: FlowControl.FlowControl := FFlowControl;
      end;
    end;
  end;
end;

// update settings from TCustomComPort
procedure TComSelect.UpdateSettings(var ItemIndex: Integer);
begin
  if FComPort <> nil then
    with FComPort do
      case FComProperty of
        cpPort:
        begin
          ItemIndex := Items.IndexOf(Port);
          if ItemIndex > -1 then
            FPort := Items[ItemIndex];
        end;
        cpBaudRate:
        begin
          ItemIndex := Items.IndexOf(BaudRateToStr(BaudRate));
          if ItemIndex > -1 then
            FBaudRate := StrToBaudRate(Items[ItemIndex]);
        end;
        cpDataBits:
        begin
          ItemIndex := Items.IndexOf(DataBitsToStr(DataBits));
          if ItemIndex > -1 then
            FDataBits := StrToDataBits(Items[ItemIndex]);
        end;
        cpStopBits:
        begin
          ItemIndex := Items.IndexOf(StopBitsToStr(StopBits));
          if ItemIndex > -1 then
            FStopBits := StrToStopBits(Items[ItemIndex]);
        end;
        cpParity:
        begin
          ItemIndex := Items.IndexOf(ParityToStr(Parity.Bits));
          if ItemIndex > -1 then
            FParity := StrToParity(Items[ItemIndex]);
        end;
        cpFlowControl:
        begin
          ItemIndex := Items.IndexOf(FlowControlToStr(FlowControl.FlowControl));
          if ItemIndex > -1 then
            FFlowControl := StrToFlowControl(Items[ItemIndex]);
        end;
      end;
end;

(*****************************************
 * TComComboBox control                  *
 *****************************************)

// create control
constructor TComComboBox.Create(AOwner: TComponent);
begin
  FComSelect := TComSelect.Create;
  inherited Create(AOwner);
  FComSelect.Items := Items;
  Style := csDropDownList;
end;

// destroy control
destructor TComComboBox.Destroy;
begin
  inherited Destroy;
  FComSelect.Free;
end;

// apply settings to TCustomComPort
procedure TComComboBox.ApplySettings;
begin
  FComSelect.ApplySettings;
end;

// update settings from TCustomComPort
procedure TComComboBox.UpdateSettings;
var
  Index: Integer;
begin
  FComSelect.UpdateSettings(Index);
  ItemIndex := Index;
end;

// remove ComPort property if being destroyed
procedure TComComboBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FComSelect.ComPort) and (Operation = opRemove) then
  begin
    FComSelect.ComPort := nil;
    if Items.Count > 0 then
      ItemIndex := 0;
  end;
end;

// perform change when selection is changed
procedure TComComboBox.Change;
begin
  FComSelect.Change(Text);
  inherited Change;
end;

// set ComPort property
procedure TComComboBox.SetComPort(const Value: TCustomComPort);
begin
  if FComSelect.ComPort <> Value then
  begin
    FComSelect.ComPort := Value;
    if FComSelect.ComPort <> nil then
    begin
      FComSelect.ComPort.FreeNotification(Self);
      // transfer settings from ComPort to this control
      UpdateSettings;
    end;
  end;
end;

function TComComboBox.GetComPort: TCustomComPort;
begin
  Result := FComSelect.ComPort;
end;

function TComComboBox.GetAutoApply: Boolean;
begin
  Result := FComSelect.AutoApply;
end;

procedure TComComboBox.SetAutoApply(const Value: Boolean);
begin
  FComSelect.AutoApply := Value;
end;

function TComComboBox.GetText: string;
begin
  if ItemIndex = -1 then
    Result := ''
  else
    Result := Items[ItemIndex];
end;

procedure TComComboBox.SetText(const Value: string);
begin
  if Items.IndexOf(Value) > -1 then
    ItemIndex := Items.IndexOf(Value);
end;

// change property for selecting
procedure TComComboBox.SetComProperty(const Value: TComProperty);
var
  Index: Integer;
begin
  FComSelect.ComProperty := Value;
  if Items.Count > 0 then
    if FComSelect.ComPort <> nil then
    begin
      // transfer settings from ComPort to this control
      FComSelect.UpdateSettings(Index);
      ItemIndex := Index;
    end
    else
      ItemIndex := 0;
end;

function TComComboBox.GetComProperty: TComProperty;
begin
  Result := FComSelect.ComProperty;
end;

(*****************************************
 * TRadioGroup control                   *
 *****************************************)

// create control
constructor TComRadioGroup.Create(AOwner: TComponent);
begin
  FComSelect := TComSelect.Create;
  inherited Create(AOwner);
  FComSelect.Items := Items;
  FOldIndex := -1;
end;

// destroy control
destructor TComRadioGroup.Destroy;
begin
  inherited Destroy;
  FComSelect.Free;
end;

// apply settings to TCustomComPort
procedure TComRadioGroup.ApplySettings;
begin
  FComSelect.ApplySettings;
end;

// update settings from TCustomComPort
procedure TComRadioGroup.UpdateSettings;
var
  Index: Integer;
begin
  FComSelect.UpdateSettings(Index);
  ItemIndex := Index;
  FOldIndex := Index;
end;

// remove ComPort property if being destroyed
procedure TComRadioGroup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FComSelect.ComPort) and (Operation = opRemove) then
  begin
    FComSelect.ComPort := nil;
    if Items.Count > 0 then
    begin
      ItemIndex := 0;
      FOldIndex := 0;
    end;
  end;
end;

// perform change when radio button is clicked
procedure TComRadioGroup.Click;
begin
  if FOldIndex <> ItemIndex then
  begin
    if ItemIndex > -1 then
      FComSelect.Change(Items[ItemIndex]);
    FOldIndex := ItemIndex;
  end;
  inherited Click;
end;

// set ComPort property
procedure TComRadioGroup.SetComPort(const Value: TCustomComPort);
begin
  if FComSelect.ComPort <> Value then
  begin
    FComSelect.ComPort := Value;
    if FComSelect.ComPort <> nil then
    begin
      FComSelect.ComPort.FreeNotification(Self);
      // transfer settings from ComPort to this control
      UpdateSettings;
    end;
  end;
end;

function TComRadioGroup.GetComPort: TCustomComPort;
begin
  Result := FComSelect.ComPort;
end;

function TComRadioGroup.GetAutoApply: Boolean;
begin
  Result := FComSelect.AutoApply;
end;

procedure TComRadioGroup.SetAutoApply(const Value: Boolean);
begin
  FComSelect.AutoApply := Value;
end;

// change property for selecting
procedure TComRadioGroup.SetComProperty(const Value: TComProperty);
var
  Index: Integer;
begin
  FComSelect.ComProperty := Value;
  if Items.Count > 0 then
    if FComSelect.ComPort <> nil then
    begin
      // transfer settings from ComPort to this control
      FComSelect.UpdateSettings(Index);
      ItemIndex := Index;
    end
    else
      ItemIndex := 0;
end;

function TComRadioGroup.GetComProperty: TComProperty;
begin
  Result := FComSelect.ComProperty;
end;

(*****************************************
 * TComLed control                       *
 *****************************************)

// create control
constructor TComLed.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csSetCaption];
  Height := 25;
  Width := 25;
  FComLink := TComLink.Create;
  FComLink.OnConn := SignalChange;
  FGlyphs[lsOn] := TLedBitmap.Create;
  FGlyphs[lsOn].Transparent := True;
  FGlyphs[lsOn].TransparentMode := tmAuto;
  FGlyphs[lsOff] := TLedBitmap.Create;
  FGlyphs[lsOff].Transparent := True;
  FGlyphs[lsOff].TransparentMode := tmAuto;
  FTimer := TTimer.Create(nil);
  FTimer.Enabled := False;
  FTimer.OnTimer := DoTimer;
end;

// destroy control
destructor TComLed.Destroy;
begin
  FTimer.Free;
  FGlyphs[lsOn].Free;
  FGlyphs[lsOff].Free;
  ComPort := nil;
  FComLink.Free;
  inherited Destroy;
end;

// paint control
procedure TComLed.Paint;
var
  Pt: TPoint;
begin
  // get bitmap handle
  BitmapNeeded;
  // calculate position
  Pt := CalcBitmapPos;
  // draw bitmap
  Canvas.Draw(Pt.x, Pt.y, BitmapToDraw);
end;

// remove ComPort if being destroyed
procedure TComLed.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FComPort) then
    ComPort := nil;
end;

// timed led state
procedure TComLed.DoTimer(Sender: TObject);
begin
  FTimer.Enabled := False;
  SetStateInternal(FPendingState);
end;

procedure TComLed.CMEnabledChanged(var Message: TMessage);
begin
  Invalidate;
end;

// trigger OnChangeEvent
procedure TComLed.DoChange(AState: TLedState);
begin
  if Assigned(FOnChange) then
    FOnChange(Self, AState);
end;

// if bitmap is empty, load it
procedure TComLed.BitmapNeeded;
begin
  if (FGlyphs[lsOn].Empty) or (FGlyphs[lsOff].Empty) then
    SelectLedBitmap(FKind);
end;

procedure TComLed.SelectLedBitmap(const LedKind: TLedKind);
const
  OnBitmaps: array[TLedKind] of string = ('LEDREDON', 'LEDGREENON', 'LEDBLUEON',
    'LEDYELLOWON', 'LEDPURPLEON', 'LEDBULBON', '');
  OffBitmaps: array[TLedKind] of string = ('LEDREDOFF', 'LEDGREENOFF',
    'LEDBLUEOFF', 'LEDYELLOWOFF', 'LEDPURPLEOFF', 'LEDBULBOFF' ,'');
begin
  if LedKind <> lkCustom then
  begin
    FGlyphs[lsOn].LoadFromResourceName(HInstance, OnBitmaps[LedKind]);
    FGlyphs[lsOff].LoadFromResourceName(HInstance, OffBitmaps[LedKind]);
  end;
end;

// calculate bitmap position
function TComLed.CalcBitmapPos: TPoint;
var
  Rect: TRect;
begin
  Rect := GetClientRect;
  Result.x := Rect.Left + Max(0, (Rect.Right - Rect.Left - FGlyphs[FState].Width) div 2);
  Result.y := Rect.Top + Max(0, (Rect.Bottom - Rect.Top - FGlyphs[FState].Height) div 2);
end;

(*
function __TimerElapsed(tick1,tick2:DWORD):DWORD;
begin
  if ((tick2-tick1) < $80000000) then { timer roll-over check }
      result := (tick2 - tick1) { normal }
  else
      result := (not tick1)+tick2; {rollover calculation}
end;
*)


// change led state on signal change
procedure TComLed.SignalChange(Sender: TObject; OnOff: Boolean);

begin

    if Ord(Self.State) = Ord(OnOff) then exit;

 if OnOff then begin
    FTimer.Enabled := False;
    SetStateInternal(lsOn);
    Application.ProcessMessages;
 end else begin
    FTimer.Enabled := true;
    FTimer.Interval := 100; // longer gap before turning off.
    FPendingState := lsOff;
 end;

end;

// change led state on ring detection
procedure TComLed.RingDetect(Sender: TObject);
begin
  FTimer.Interval := FRingDuration;
  FTimer.Enabled := True;
  SetStateInternal(lsOn);
  FPendingState := lsOff;
end;

// detect the state of led
function TComLed.IsStateOn: Boolean;
begin
  case FLedSignal of
    lsCTS: Result := (csCTS in FComPort.Signals);
    lsDSR: Result := (csDSR in FComPort.Signals);
    lsRLSD: Result := (csRLSD in FComPort.Signals);
    lsRing: Result := False;
    lsTx: Result := False;
    lsRx: Result := False;
    lsConn: Result := (FComPort <> nil) and (FComPort.Connected);
  else
    Result := False;
  end;
end;

// set led state
procedure TComLed.SetStateInternal(const Value: TLedState);
begin
  FState := Value;
  if not (csLoading in ComponentState) then
    DoChange(FState);
  FPendingInvalidate:=true;
end;

// set led kind
procedure TComLed.SetKind(const Value: TLedKind);
begin
  if FKind <> Value then
  begin
    FKind := Value;
    SelectLedBitmap(FKind);
    Invalidate;
  end;
end;

// set ComPort property
procedure TComLed.SetComPort(const Value: TComPort);
begin
  if Value <> FComPort then
  begin
    if FComPort <> nil then
      FComPort.UnRegisterLink(FComLink);
    FComPort := Value;
    if FComPort <> nil then
    begin
      FComPort.FreeNotification(Self);
      FComPort.RegisterLink(FComLink);
      if (FComPort.Connected) and (not (csDesigning in ComponentState))
          and (not (csLoading in ComponentState)) then
        if IsStateOn then
          SetStateInternal(lsOn)
        else
          SetStateInternal(lsOff);
    end
    else
      SetStateInternal(lsOff);
  end;
end;

// set led state
procedure TComLed.SetState(const Value: TLedState);
begin
  if FComPort <> nil then
    raise EComPort.Create('ComLed ',CError_LedStateFailed);
  SetStateInternal(Value);
end;

// select which signal to watch
procedure TComLed.SetLedSignal(const Value: TComLedSignal);
begin
  if FLedSignal <> Value then
  begin
    FLedSignal := Value;
    FComLink.OnCTSChange := nil;
    FComLink.OnDSRChange := nil;
    FComLink.OnRLSDChange := nil;
    FComLink.OnRing := nil;
    FComLink.OnTx := nil;
    FComLink.OnRx := nil;
    FComLink.OnConn := nil;
    case FLedSignal of
      lsCTS: FComLink.OnCTSChange := SignalChange;
      lsDSR: FComLink.OnDSRChange := SignalChange;
      lsRLSD: FComLink.OnRLSDChange := SignalChange;
      lsRing: FComLink.OnRing := RingDetect;
      lsTx: FComLink.OnTx := SignalChange;
      lsRx: FComLink.OnRx := SignalChange;
      lsConn: FComLink.OnConn := SignalChange;
    end;
  end;
end;

function TComLed.GetGlyph(const Index: Integer): TLedBitmap;
begin
  case Index of
    0: Result := FGlyphs[lsOn];
    1: Result := FGlyphs[lsOff];
  else
    Result := nil;
  end;
end;

// set custom bitmap
procedure TComLed.SetGlyph(const Index: Integer; const Value: TLedBitmap);
begin
  if FKind = lkCustom then
  begin
    Value.TransparentMode := tmAuto;
    Value.Transparent := True;
    case Index of
      0: FGlyphs[lsOn].Assign(Value);
      1: FGlyphs[lsOff].Assign(Value);
    end;
    Invalidate;
  end;
end;

function TComLed.StoredGlyph(const Index: Integer): Boolean;
begin
  Result := FKind = lkCustom;
end;

// get bitmap for drawing
function TComLed.BitmapToDraw: TLedBitmap;
var
  ToDraw: TLedState;
begin
  if not Enabled then
    ToDraw := lsOff
  else
    ToDraw := FState;
  Result := FGlyphs[ToDraw];
end;


(*****************************************
 * TComTermBuffer class                  *
 *****************************************)

// create class
constructor TComTermBuffer.Create(AOwner: TCustomComTerminal);
begin
  inherited Create;
  FOwner := AOwner;
end;

// destroy class
destructor TComTermBuffer.Destroy;
begin
  if FBuffer <> nil then
  begin
    FreeMem(FBuffer);
    FreeMem(FTabs);
  end;
  inherited Destroy;
end;

// put char in buffer
procedure TComTermBuffer.SetChar(Column, Row: Integer;
  TermChar: TComTermChar);
var
  Address: Integer;
begin
  Address := (Row - 1) * FOwner.Columns + Column - 1;
  Move(
    TermChar,
    Pointer(Integer(FBuffer) + (SizeOf(TComTermChar) * Address))^,
    SizeOf(TComTermChar));
end;

// get char from buffer
function TComTermBuffer.GetChar(Column, Row: Integer): TComTermChar;
var
  Address: Integer;
begin
  Address := (Row - 1) * FOwner.Columns + Column - 1;
  Move(
    Pointer(Integer(FBuffer) + (SizeOf(TComTermChar) * Address))^,
    Result,
    SizeOf(TComTermChar));
end;

// scroll down up line
procedure TComTermBuffer.ScrollDown;
var
  BytesToMove: Integer;
  SourceAddr: Pointer;
  ScrollRect: TRect;
begin
  BytesToMove := (FOwner.Rows - 1) * FOwner.Columns * SizeOf(TComTermChar);
  SourceAddr := Pointer(Integer(FBuffer) + FOwner.Columns * SizeOf(TComTermChar));
  // scroll in buffer
  Move(SourceAddr^, FBuffer^, BytesToMove);
  SourceAddr := Pointer(Integer(FBuffer) +
    (FOwner.Rows - 1) * FOwner.Columns * SizeOf(TComTermChar));
  FillChar(SourceAddr^, FOwner.Columns * SizeOf(TComTermChar), 0);
  // calculate scrolling rectangle
  with ScrollRect do
  begin
    Left := 0;
    Right := Min(FOwner.ClientWidth, FOwner.Columns * FOwner.FFontWidth);
    Top := 0;
    Bottom := Min(FOwner.ClientHeight, FOwner.Rows * FOwner.FFontHeight);
  end;
  // scroll on screen
{$IFDEF DELPHI_4_OR_HIGHER}
  if FOwner.DoubleBuffered then
    FOwner.Invalidate
  else
{$ENDIF}
    ScrollWindowEx(FOwner.Handle, 0, -FOwner.FFontHeight,
      @ScrollRect, nil, 0, nil, SW_INVALIDATE or SW_ERASE);
end;

// scroll up one line
procedure TComTermBuffer.ScrollUp;
var
  BytesToMove: Integer;
  DestAddr: Pointer;
  ScrollRect: TRect;
begin
  BytesToMove := (FOwner.Rows - 1) * FOwner.Columns * SizeOf(TComTermChar);
  DestAddr := Pointer(Integer(FBuffer) + FOwner.Columns * SizeOf(TComTermChar));
  // scroll in buffer
  Move(FBuffer^, DestAddr^, BytesToMove);
  FillChar(FBuffer^, FOwner.Columns * SizeOf(TComTermChar), 0);
  // calculate scrolling rectangle
  with ScrollRect do
  begin
    Left := 0;
    Right := Min(FOwner.ClientWidth, FOwner.Columns * FOwner.FFontWidth);
    Top := 0;
    Bottom := Min(FOwner.ClientHeight, FOwner.Rows * FOwner.FFontHeight);
  end;
  // scroll on screen
{$IFDEF DELPHI_4_OR_HIGHER}
  if FOwner.DoubleBuffered then
    FOwner.Invalidate
  else
{$ENDIF}
    ScrollWindowEx(FOwner.Handle, 0, FOwner.FFontHeight,
      @ScrollRect, nil, 0, nil, SW_INVALIDATE or SW_ERASE);
end;

// erase line
procedure TComTermBuffer.EraseLine(Column, Row: Integer);
var
  BytesToDelete: Integer;
  SourceAddr: Pointer;
begin
  // in memory
  BytesToDelete := (FOwner.Columns - Column + 1) * SizeOf(TComTermChar);
  SourceAddr := Pointer(Integer(FBuffer) +
    ((Row - 1) * FOwner.Columns + Column - 1) * SizeOf(TComTermChar));
  FillChar(SourceAddr^, BytesToDelete, 0);
  // on screen
{$IFDEF DELPHI_4_OR_HIGHER}
  if FOwner.DoubleBuffered then
    FOwner.Invalidate
  else
{$ENDIF}
    FOwner.InvalidatePortion(Rect(Column, Row, FOwner.Columns, Row));
end;

// erase screen
procedure TComTermBuffer.EraseScreen(Column, Row: Integer);
var
  BytesToDelete: Integer;
  SourceAddr: Pointer;
begin
  // in memory
  BytesToDelete := (FOwner.Columns - Column + 1 +
    (FOwner.Rows - Row) * FOwner.Columns) * SizeOf(TComTermChar);
  SourceAddr := Pointer(Integer(FBuffer) +
    ((Row - 1) * FOwner.Columns + Column - 1) * SizeOf(TComTermChar));
  FillChar(SourceAddr^, BytesToDelete, 0);
  // on screen
{$IFDEF DELPHI_4_OR_HIGHER}
  if FOwner.DoubleBuffered then
    FOwner.Invalidate
  else
{$ENDIF}
    FOwner.InvalidatePortion(Rect(Column, Row, FOwner.Columns, FOwner.Rows))
end;

// init buffer
procedure TComTermBuffer.Init;
var
  I: Integer;
begin
  if FBuffer <> nil then
  begin
    FreeMem(FBuffer);
    FreeMem(FTabs);
  end;
  GetMem(FBuffer, FOwner.Columns * FOwner.Rows * SizeOf(TComTermChar));
  FillChar(FBuffer^, FOwner.Columns * FOwner.Rows * SizeOf(TComTermChar), 0);
  GetMem(FTabs, FOwner.Columns * SizeOf(Boolean));
  FillChar(FTabs^, FOwner.Columns * SizeOf(Boolean), 0);
  I := 1;
  while (I <= FOwner.Columns) do
  begin
    SetTab(I, True);
    Inc(I, 8);
  end;
end;

// get tab at Column
function TComTermBuffer.GetTab(Column: Integer): Boolean;
begin
  Result := Boolean(Pointer(Integer(FTabs) + (Column - 1) * SizeOf(Boolean))^);
end;

// set tab at column
procedure TComTermBuffer.SetTab(Column: Integer; Put: Boolean);
begin
  Boolean(Pointer(Integer(FTabs) + (Column - 1) * SizeOf(Boolean))^) := Put;
end;

// find nexts tab position
function TComTermBuffer.NextTab(Column: Integer): Integer;
var
  I: Integer;
begin
  I := Column;
  while (I <= FOwner.Columns) do
    if GetTab(I) then
      Break
    else
      Inc(I);
  if I > FOwner.Columns then
    Result := 0
  else
    Result := I;
end;

// clear all tabs
procedure TComTermBuffer.ClearAllTabs;
begin
  FillChar(FTabs^, FOwner.Columns * SizeOf(Boolean), 0);
end;

function TComTermBuffer.GetLineLength(Line: Integer): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to FOwner.Columns do
    if GetChar(I, Line).Ch <> #0 then
      Result := I;
end;

function TComTermBuffer.GetLastLine: Integer;
var
  J: Integer;
begin
  Result := 0;
  for J := 1 to FOwner.Rows do
    if GetLineLength(J) > 0 then
      Result := J;
end;

// get last Character in buffer
(*****************************************
 * TComCustomTerminal control            *
 *****************************************)

// create control
constructor TCustomComTerminal.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BorderStyle := bsSingle;
  Color := clBlack;
  TabStop := True;
  Width := 400;
  Height := 250;
  Font := ComTerminalFont;
  FAltColor := $00A6A6A6;
  FComLink := TComLink.Create;
  FComLink.OnRxBuf := RxBuf;
  FEmulation := teVT100orANSI;
  FColumns := 80;
  FRows := 24;
  FCaretPos := Point(1, 1);
  FTopLeft := Point(1, 1);
  FScrollBars := ssBoth;
  FBuffer := TComTermBuffer.Create(Self);
  FTermAttr.FrontColor := Font.Color;
  FTermAttr.BackColor := Color;
end;

// destroy control
destructor TCustomComTerminal.Destroy;
begin
  ComPort := nil;
  FBuffer.Free;
  FEscapeCodes.Free;
  FComLink.Free;
  inherited Destroy;
end;

// clear terminal screen
procedure TCustomComTerminal.ClearScreen;
begin
  FBuffer.Init;
  MoveCaret(1, 1);
  Invalidate;
end;

// move caret
procedure TCustomComTerminal.MoveCaret(AColumn, ARow: Integer);
begin
  if AColumn > FColumns then
    FCaretPos.X := FColumns
  else
    if AColumn < 1 then
      FCaretPos.X := 1
    else
      FCaretPos.X := AColumn;

  if ARow > FRows then
    FCaretPos.Y := FRows
  else
    if ARow < 1 then
      FCaretPos.Y := 1
    else
      FCaretPos.Y := ARow;

  if FCaretCreated then
    SetCaretPos((FCaretPos.X - FTopLeft.X) * FFontWidth,
      (FCaretPos.Y - FTopLeft.Y) * FFontHeight + FFontHeight - FCaretHeight);
end;

// write data to screen (ancient const-Buffer-untyped)
procedure TCustomComTerminal.Write(const Buffer:TCPortBytes; Size: Integer);
var
 Str:AnsiString;
begin
//  SetLength(Str,Size);
//  Move(Buffer,Str,Size);
SetString(Str,PAnsiChar(Buffer),Size);
  WriteStr(  String(str));
end;

procedure TCustomComTerminal.WriteStr(const Str: string);
var
  I: Integer;
  Res: TEscapeResult;
  Ch: Char;
begin
  HideCaret;
  try
    // show it on screen
    for I := 0 to Length(Str)-1 do
    begin
      Ch := Str[I+1]; //  Char(Pointer(Integer(@Buffer) + I)^); { Dejan, you're an idiot. }
      if FEscapeCodes <> nil then
      begin
        Res := FEscapeCodes.ProcessChar(Ch);
        if Res = erChar then
          PutChar(FEscapeCodes.Character);
        if Res = erCode then
        begin
          if not PutEscapeCode(FEscapeCodes.Code, FEscapeCodes.Params) then
             DoUnhandledCode(FEscapeCodes.Code, FEscapeCodes.Data);
          FEscapeCodes.Params.Clear;
        end;
      end
      else
        PutChar(Ch);
    end;
  finally
    ShowCaret;
  end;
end;

// write string on screen, but not to port

// write escape code on screen
procedure TCustomComTerminal.WriteEscCode(ACode: TEscapeCode;
  AParams: TStrings);
begin
  if FEscapeCodes <> nil then
    PutEscapeCode(ACode, AParams);
end;

// load screen buffer from file
procedure TCustomComTerminal.LoadFromStream(Stream: TStream);
var
  I: Integer;
  Ch: Char;
begin
  HideCaret;
  for I := 0 to Stream.Size - 1 do
  begin
    Stream.Read(Ch, 1);
    PutChar(Ch);
  end;
  ShowCaret;
end;

// save screen buffer to file
procedure TCustomComTerminal.SaveToStream(Stream: TStream);
var
  I, J, LastChar, LastLine: Integer;
  Ch: Char;
  EndLine: string;
begin
  EndLine := #13#10;
  LastLine := FBuffer.GetLastLine;
  for J := 1 to LastLine do
  begin
    LastChar := FBuffer.GetLineLength(J);
    if LastChar > 0 then
    begin
      for I := 1 to LastChar do
      begin
        Ch := FBuffer.GetChar(I, J).Ch;
        // replace null Characters with blanks
        if Ch = #0 then
          Ch := #32;
        Stream.Write(Ch, 1);
      end;
    end;
    // new line
    if J <> LastLine then
      Stream.Write(EndLine[1], Length(EndLine));
  end;
end;

// select terminal font
procedure TCustomComTerminal.SelectFont;
begin
  with TFontDialog.Create(Application) do
  begin
    Options := Options + [fdFixedPitchOnly];
    Font := Self.Font;
    if Execute then
      Self.Font := Font;
    Free;
  end;
end;

// show terminal setup dialog
procedure TCustomComTerminal.ShowSetupDialog;
begin
  EditComTerminal(Self);
end;

procedure TCustomComTerminal.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then
    RecreateWnd;
  inherited;
end;

// process font change
procedure TCustomComTerminal.CMFontChanged(var Message: TMessage);
begin
  inherited;
  FTermAttr.FrontColor := Font.Color;
  if not CalculateMetrics then
    Font.Name := ComTerminalFont.Name;
  if fsUnderline in Font.Style then
    Font.Style := Font.Style - [fsUnderline];
{$IFDEF DELPHI_4_OR_HIGHER}
  AdjustSize;
{$ENDIF}
  UpdateScrollRange;
end;

procedure TCustomComTerminal.CMColorChanged(var Message: TMessage);
begin
  inherited;
  FTermAttr.BackColor := Color;
end;

procedure TCustomComTerminal.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  // request arrow keys and WM_CHAR message to be handled by the control
  Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
  // tab key
  if FWantTab then
    Message.Result := Message.Result or DLGC_WANTTAB;
end;

// lost focus
procedure TCustomComTerminal.WMKillFocus(var Message: TWMSetFocus);
begin
  // destroy caret because it could be requested by some other control
  DestroyCaret;
  FCaretCreated := False;
  inherited;
end;

// gained focus
procedure TCustomComTerminal.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  // control activated, create caret
  InitCaret;
end;

// left button pressed
procedure TCustomComTerminal.WMLButtonDown(var Message: TWMLButtonDown);
begin
  // set focus when left button down
  if CanFocus and TabStop then
    SetFocus;
  inherited;
end;

// size changed
procedure TCustomComTerminal.WMSize(var Msg: TWMSize);
begin
  inherited;
  UpdateScrollRange;
end;

// vertical scroll
procedure TCustomComTerminal.WMHScroll(var Message: TWMHScroll);
begin
  ModifyScrollBar(SB_HORZ, Message.ScrollCode, Message.Pos);
end;

// horizontal scroll
procedure TCustomComTerminal.WMVScroll(var Message: TWMVScroll);
begin
  ModifyScrollBar(SB_VERT, Message.ScrollCode, Message.Pos);
end;

{$IFDEF DELPHI_4_OR_HIGHER}
// set size to fit whole terminal screen
function TCustomComTerminal.CanAutoSize(var NewWidth,
  NewHeight: Integer): Boolean;
var
  Border: Integer;
begin
  Result := True;
  if Align in [alNone, alLeft, alRight] then
  begin
    NewWidth := FFontWidth * FColumns;
    if FBorderStyle = bsSingle then
    begin
      if Ctl3D then
        Border := SM_CXEDGE
      else
        Border := SM_CXBORDER;
      NewWidth := NewWidth + 2 * GetSystemMetrics(BORDER);
    end;
  end;
  if Align in [alNone, alTop, alBottom] then
  begin
    NewHeight := FFontHeight * FRows;
    if FBorderStyle = bsSingle then
    begin
      if Ctl3D then
        Border := SM_CYEDGE
      else
        Border := SM_CYBORDER;
      NewHeight := NewHeight + 2 * GetSystemMetrics(Border);
    end;
  end;
end;
{$ENDIF}

// set control parameters
procedure TCustomComTerminal.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
    if FScrollBars in [ssVertical, ssBoth] then
      Style := Style or WS_VSCROLL;
    if FScrollBars in [ssHorizontal, ssBoth] then
      Style := Style or WS_HSCROLL;
  end;
end;

// key down
procedure TCustomComTerminal.KeyDown(var Key: Word; Shift: TShiftState);
var
  Code: TEscapeCode;
begin
  inherited KeyDown(Key, Shift);
  case Key of
    VK_UP: Code := ecCursorUp;
    VK_DOWN: Code := ecCursorDown;
    VK_LEFT: Code := ecCursorLeft;
    VK_RIGHT: Code := ecCursorRight;
    VK_HOME: Code := ecCursorHome;
  else
    Code := ecUnknown;
  end;
  if FTermMode.Keys = akTerminal then
  begin
    if Code <> ecUnknown then
      if FArrowKeys = akTerminal then
        SendCode(Code, nil)
      else
        PutEscapeCode(Code, nil);
  end
  else
    case Code of
      ecCursorUp: SendCode(ecAppCursorUp, nil);
      ecCursorDown: SendCode(ecAppCursorDown, nil);
      ecCursorLeft: SendCode(ecAppCursorLeft, nil);
      ecCursorRight: SendCode(ecAppCursorRight, nil);
    end;
end;

// key pressed
procedure TCustomComTerminal.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  SendChar(Key);
end;

procedure TCustomComTerminal.Loaded;
begin
  inherited Loaded;
  CreateEscapeCodes;
  if not (csDesigning in ComponentState) then
    FBuffer.Init;
end;

procedure TCustomComTerminal.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FComPort) and (Operation = opRemove) then
    ComPort := nil;
end;

// paint Characters
procedure TCustomComTerminal.PaintTerminal(Rect: TRect);
var
  I, J, X, Y: Integer;
  Ch: TComTermChar;
begin
  if (Rect.Bottom + FTopLeft.Y - 1) > FRows then
    Dec(Rect.Bottom);
  if (Rect.Right + FTopLeft.X - 1) > FColumns then
    Dec(Rect.Right);
  for J := Rect.Top to Rect.Bottom do
  begin
    Y := J + FTopLeft.Y - 1;
    for I := Rect.Left to Rect.Right do
    begin
      X := I + FTopLeft.X - 1;
      Ch := FBuffer.GetChar(X, Y);
      if Ch.Ch <> Chr(0) then
        DrawChar(I, J, Ch);
    end;
  end;
end;

procedure TCustomComTerminal.PaintDesign;
begin
  Canvas.TextOut(0, 0, 'ComPort Library');
  Canvas.Font.Color := FAltColor;
  Canvas.TextOut(0, FFontHeight, 'ComPort Library');
  Canvas.Font.Color := Font.Color;
  PatBlt(Canvas.Handle, 0, 0, FFontWidth, FFontHeight * 2, DSTINVERT);
end;

procedure TCustomComTerminal.Paint;
var
  ARect: TRect;
begin
  Canvas.Font := Font;
  Canvas.Brush.Color := Color;
  if csDesigning in ComponentState then
    PaintDesign
  else
  begin
    MoveCaret(FCaretPos.X, FCaretPos.Y);
    // don't paint whole screen, but only the invalidated portion
    ARect.Left := Canvas.ClipRect.Left div FFontWidth + 1;
    ARect.Right := Min(Canvas.ClipRect.Right div FFontWidth + 1, FColumns);
    ARect.Top := Canvas.ClipRect.Top div FFontHeight + 1;
    ARect.Bottom := Min(Canvas.ClipRect.Bottom div FFontHeight + 1, FRows);
    PaintTerminal(ARect);
  end;
end;

// creates caret
procedure TCustomComTerminal.CreateTerminalCaret;
begin
  FCaretHeight := 0;
  if FCaret = tcBlock then
    FCaretHeight := FFontHeight
  else
    if FCaret = tcUnderline then
      FCaretHeight := FFontHeight div 8;
  if FCaretHeight > 0 then
  begin
    CreateCaret(Handle, 0, FFontWidth, FCaretHeight);
    FCaretCreated := True;
  end;
end;

// string received from com port
procedure TCustomComTerminal.StringReceived(Str: string);
begin
  DoStrRecieved(Str);
  WriteStr(Str);
end;

// draw one Character on screen, but do not put it in buffer
procedure TCustomComTerminal.DrawChar(AColumn, ARow: Integer;
  Ch: TComTermChar);
var
  OldBackColor, OldFrontColor: Integer;
begin
  OldBackColor := Canvas.Brush.Color;
  OldFrontColor := Canvas.Font.Color;
  Canvas.Brush.Color := Ch.BackColor;
  Canvas.Font.Color := Ch.FrontColor;
  if Ch.Underline then
    Canvas.Font.Style := Canvas.Font.Style + [fsUnderline]
  else
    Canvas.Font.Style := Canvas.Font.Style - [fsUnderline];
  Canvas.TextOut((AColumn - 1) * FFontWidth, (ARow - 1) * FFontHeight, Ch.Ch);
  Canvas.Brush.Color := OldBackColor;
  Canvas.Font.Color := OldFrontColor;
end;

// move caret after new char is put on screen
procedure TCustomComTerminal.AdvanceCaret(Kind: TAdvanceCaret);
var
  I: Integer;
begin
  case Kind of
    acChar:
      begin
        if FCaretPos.X = FColumns then
        begin
          if FWrapLines then
            if FCaretPos.Y = FRows then
            begin
              FBuffer.ScrollDown;
              MoveCaret(1, FCaretPos.Y);
            end
            else
              MoveCaret(1, FCaretPos.Y + 1)
        end
        else
          MoveCaret(FCaretPos.X + 1, FCaretPos.Y);
      end;
    acReturn: MoveCaret(1, FCaretPos.Y);
    acLineFeed:
      begin
        if FCaretPos.Y = FRows then
          FBuffer.ScrollDown
        else
          MoveCaret(FCaretPos.X, FCaretPos.Y + 1);
      end;
    acReverseLineFeed:
      begin
        if FCaretPos.Y = 1 then
          FBuffer.ScrollUp
        else
          MoveCaret(FCaretPos.X, FCaretPos.Y - 1);
      end;
    acBackSpace: MoveCaret(FCaretPos.X - 1, FCaretPos.Y);
    acTab:
      begin
        I := FBuffer.NextTab(FCaretPos.X + 1);
        if I > 0 then
          MoveCaret(I, FCaretPos.Y);
      end;
  end;
end;

// set Character attributes
procedure TCustomComTerminal.SetAttributes(AParams: TStrings);
var
  I, Value: Integer;

  procedure AllOff;
  begin
    FTermAttr.FrontColor := Font.Color;
    FTermAttr.BackColor := Color;
    FTermAttr.Invert := False;
    FTermAttr.AltIntensity := False;
    FTermAttr.Underline := False;
  end;

begin
  if AParams.Count = 0 then
    AllOff;
  for I := 1 to AParams.Count do
  begin
    Value := FEscapeCodes.GetParam(I, AParams);
    case Value of
      0:  AllOff;
      1:  FTermAttr.AltIntensity := True;
      4:  FTermAttr.Underline := True;
      7:  FTermAttr.Invert := True;
      21: FTermAttr.AltIntensity := False;
      24: FTermAttr.Underline := False;
      27: FTermAttr.Invert := False;
    end;
  end;
end;

procedure TCustomComTerminal.SetMode(AParams: TStrings; OnOff: Boolean);
var
  Str: string;
begin
  if AParams.Count = 0 then
    Exit;
  Str := AParams[0];
  if Str = '?1' then
    if OnOff then
      FTermMode.Keys := akWindows
    else
      FTermMode.Keys := akTerminal;
  if Str = '7' then
    FWrapLines := OnOff;
  if Str = '?3' then
    if OnOff then
      Columns := 132
    else
      Columns := 80;
end;

// invalidate portion of screen
procedure TCustomComTerminal.InvalidatePortion(ARect: TRect);
var
  Rect: TRect;
begin
  Rect.Left := Max((ARect.Left - FTopLeft.X) * FFontWidth, 0);
  Rect.Right := Max((ARect.Right - FTopLeft.X + 1) * FFontWidth, 0);
  Rect.Top := Max((ARect.Top - FTopLeft.Y) * FFontHeight, 0);
  Rect.Bottom := Max((ARect.Bottom - FTopLeft.Y + 1) * FFontHeight, 0);
  InvalidateRect(Handle, @Rect, True);
end;

// modify scroll bar
procedure TCustomComTerminal.ModifyScrollBar(ScrollBar, ScrollCode,
  Pos: Integer);
var
  CellSize, OldPos, APos, Dx, Dy: Integer;
begin
  if (ScrollCode = SB_ENDSCROLL) or
    ((ScrollCode = SB_THUMBTRACK) and not FSmoothScroll)
  then
    Exit;
  if ScrollBar = SB_HORZ then
    CellSize := FFontWidth
  else
    CellSize := FFontHeight;
  APos := GetScrollPos(Handle, ScrollBar);
  OldPos := APos;
  case ScrollCode of
    SB_LINEUP: Dec(APos);
    SB_LINEDOWN: Inc(APos);
    SB_PAGEUP: Dec(APos, ClientHeight div CellSize);
    SB_PAGEDOWN: Inc(APos, ClientHeight div CellSize);
    SB_THUMBPOSITION,
    SB_THUMBTRACK: APos := Pos;
  end;
  SetScrollPos(Handle, ScrollBar, APos, True);
  APos := GetScrollPos(Handle, ScrollBar);
  if ScrollBar = SB_HORZ then
  begin
    FTopLeft.X := APos + 1;
    Dx := (OldPos - APos) * FFontWidth;
    Dy := 0;
  end else
  begin
    FTopLeft.Y := APos + 1;
    Dx := 0;
    Dy := (OldPos - APos) * FFontHeight;
  end;
{$IFDEF DELPHI_4_OR_HIGHER}
  if DoubleBuffered then
    Invalidate
  else
{$ENDIF}
    ScrollWindowEx(Handle, Dx, Dy, nil, nil, 0, nil, SW_ERASE or SW_INVALIDATE);
end;

// calculate scroll position
procedure TCustomComTerminal.UpdateScrollPos;
begin
  if FScrollBars in [ssBoth, ssHorizontal] then
  begin
    FTopLeft.X := GetScrollPos(Handle, SB_HORZ) + 1;
    SetScrollPos(Handle, SB_HORZ, FTopLeft.X - 1, True);
  end;
  if FScrollBars in [ssBoth, ssVertical] then
  begin
    FTopLeft.Y := GetScrollPos(Handle, SB_VERT) + 1;
    SetScrollPos(Handle, SB_VERT, FTopLeft.Y - 1, True);
  end;
end;

// calculate scroll range
procedure TCustomComTerminal.UpdateScrollRange;
var
  OldScrollBars: TScrollStyle;
  AHeight, AWidth: Integer;

  // is scroll bar visible?
  function ScrollBarVisible(Code: Word): Boolean;
  var
    Min, Max: Integer;
  begin
    Result := False;
    if (ScrollBars = ssBoth) or
      ((Code = SB_HORZ) and (ScrollBars = ssHorizontal)) or
      ((Code = SB_VERT) and (ScrollBars = ssVertical)) then
    begin
      GetScrollRange(Handle, Code, Min, Max);
      Result := Min <> Max;
    end;
  end;

  procedure SetRange(Code, Max: Integer);
  begin
    SetScrollRange(Handle, Code, 0, Max - 1, False);
  end;

  // set horizontal range
  procedure SetHorzRange;
  var
    Max: Integer;
    AColumns: Integer;
  begin
    if OldScrollBars in [ssBoth, ssHorizontal] then
    begin
      AColumns := AWidth div FFontWidth;
      if AColumns >= FColumns then
        SetRange(SB_HORZ, 1) // screen is wide enough, hide scroll bar
      else
      begin
        Max := FColumns - (AColumns - 1);
        SetRange(SB_HORZ, Max);
      end;
    end;
  end;

  // set vertical range
  procedure SetVertRange;
  var
    Max, ARows: Integer;
  begin
    if OldScrollBars in [ssBoth, ssVertical] then
    begin
      ARows := AHeight div FFontHeight;
      if ARows >= FRows then
        SetRange(SB_VERT, 1)  // screen is high enough, hide scroll bar
      else
      begin
        Max := FRows - (ARows - 1);
        SetRange(SB_VERT, Max);
      end;
    end;
  end;

begin
  if (FScrollBars = ssNone) then
    Exit;
  AHeight := ClientHeight;
  AWidth := ClientWidth;
  if ScrollBarVisible(SB_HORZ) then
    Inc(AHeight, GetSystemMetrics(SM_CYHSCROLL));
  if ScrollBarVisible(SB_VERT) then
    Inc(AWidth, GetSystemMetrics(SM_CXVSCROLL));
  // Temporarily mark us as not having scroll bars to avoid recursion
  OldScrollBars := FScrollBars;
  FScrollBars := ssNone;
  try
    SetHorzRange;
    AHeight := ClientHeight;
    SetVertRange;
    if AWidth <> ClientWidth then
    begin
      AWidth := ClientWidth;
      SetHorzRange;
    end;
  finally
    FScrollBars := OldScrollBars;
  end;
  // range changed, update scroll bar position
  UpdateScrollPos;
end;

// hide caret
procedure TCustomComTerminal.HideCaret;
begin
  if FCaretCreated then
    Windows.HideCaret(Handle);
end;

// show caret
procedure TCustomComTerminal.ShowCaret;
begin
  if FCaretCreated then
    Windows.ShowCaret(Handle);
end;

// send Character to com port
procedure TCustomComTerminal.SendChar(Ch: Char); { WAP Modified }
begin
   if FLocalEcho then
   begin
      // local echo is on, show Character on screen
      HideCaret;
      PutChar(Ch);
      ShowCaret;
      if (FSendLf) and (Ch=Chr(13)) and (not Assigned(FComPort)) then begin
            HideCaret;
            PutChar(Chr(10));
            ShowCaret;
      end;
   end;
    
  if (FComPort <> nil) and (FComPort.Connected) then
  begin
    FComPort.WriteStr( AnsiString(Ch) );
    // send line feeds after carriage return
    if (Ch = Chr(13)) and FSendLF then
      SendChar(Chr(10));
  end;
end;

// send escape code
procedure TCustomComTerminal.SendCode(Code: TEscapeCode; AParams: TStrings);
begin
  if (FComPort <> nil) and (FComPort.Connected) and (FEscapeCodes <> nil) then
  begin
    FComPort.WriteStr( FEscapeCodes.EscCodeToStr(Code, AParams) );
    if FLocalEcho then
    begin
      // local echo is on, show Character on screen
      HideCaret;
      PutEscapeCode(Code, AParams);
      ShowCaret;
    end;
  end;
end;

// send escape code to port
procedure TCustomComTerminal.SendCodeNoEcho(Code: TEscapeCode; AParams: TStrings);
begin
  if (FComPort <> nil) and (FComPort.Connected) and (FEscapeCodes <> nil) then
    FComPort.WriteStr(FEscapeCodes.EscCodeToStr(Code, AParams));
end;

// process escape code on screen
function TCustomComTerminal.PutEscapeCode(ACode: TEscapeCode; AParams: TStrings): Boolean;
begin
  Result := True;
  with FEscapeCodes do
    case ACode of
      ecCursorUp,
      ecAppCursorUp: MoveCaret(FCaretPos.X, FCaretPos.Y - GetParam(1, AParams));
      ecCursorDown: MoveCaret(FCaretPos.X, FCaretPos.Y + GetParam(1, AParams));
      ecCursorRight: MoveCaret(FCaretPos.X + GetParam(1, AParams), FCaretPos.Y);
      ecCursorLeft: MoveCaret(FCaretPos.X - GetParam(1, AParams), FCaretPos.Y);
      ecCursorHome,
      ecCursorMove: MoveCaret(GetParam(2, AParams), GetParam(1, AParams));
      ecReverseLineFeed: AdvanceCaret(acReverseLineFeed);
      ecEraseLineFrom: FBuffer.EraseLine(FCaretPos.X, FCaretPos.Y);
      ecEraseScreenFrom: FBuffer.EraseScreen(FCaretPos.X, FCaretPos.Y);
      ecEraseScreen: begin FBuffer.EraseScreen(1, 1); MoveCaret(1, 1) end;
      ecEraseLine:
      begin
        FBuffer.EraseLine(1, FCaretPos.Y);
        MoveCaret(1, FCaretPos.Y)
      end;
      ecIdentify:
      begin
        AParams.Clear;
        AParams.Add('2');
        SendCodeNoEcho(ecIdentResponse, AParams);
      end;
      ecSetTab: FBuffer.SetTab(FCaretPos.X, True);
      ecClearTab: FBuffer.SetTab(FCaretPos.X, False);
      ecClearAllTabs: FBuffer.ClearAllTabs;
      ecAttributes: SetAttributes(AParams);
      ecSetMode: SetMode(AParams, True);
      ecResetMode: SetMode(AParams, False);
      ecReset:
      begin
        AParams.Clear;
        AParams.Add('0');
        SetAttributes(AParams);
      end;
      ecSaveCaret: SaveCaretPos;
      ecRestoreCaret: RestoreCaretPos;
      ecSaveCaretAndAttr: begin SaveCaretPos; SaveAttr; end;
      ecRestoreCaretAndAttr: begin RestoreCaretPos; RestoreAttr; end;
      ecQueryCursorPos:
      begin
        AParams.Clear;
        AParams.Add(IntToStr(FCaretPos.Y));
        AParams.Add(IntToStr(FCaretPos.X));
        SendCodeNoEcho(ecReportCursorPos, AParams);
      end;
      ecQueryDevice: SendCodeNoEcho(ecReportDeviceOK, nil);
      ecTest: PerformTest('E');
    else
      Result := False;
    end;
end;

// calculate font height and width
function TCustomComTerminal.CalculateMetrics: Boolean;
var
  SaveFont, DC: THandle;
  Metrics: TTextMetric;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  FFontHeight := Metrics.tmHeight;
  FFontWidth := Metrics.tmMaxCharWidth;
  // allow only fixed pitch fonts
  Result := (Metrics.tmPitchAndFamily and TMPF_FIXED_PITCH) = 0;
end;

// visual Character is appears on screen
procedure TCustomComTerminal.DoChar(Ch: Char);
begin
  if Assigned(FOnChar) then
    FOnChar(Self, Ch);
end;

// get custom escape codes processor
procedure TCustomComTerminal.DoGetEscapeCodes(
  var EscapeCodes: TEscapeCodes);
begin
  if Assigned(FOnGetEscapeCodes) then
    FOnGetEscapeCodes(Self, EscapeCodes);
end;

// string recieved
procedure TCustomComTerminal.DoStrRecieved(var Str: string);
begin
  if Assigned(FOnStrRecieved) then
    FOnStrRecieved(Self, Str);
end;

// let application handle unhandled escape code
procedure TCustomComTerminal.DoUnhandledCode(Code: TEscapeCode;
  Data: string);
begin
  if Assigned(FOnUnhandledCode) then
    FOnUnhandledCode(Self, Code, Data);
end;

// create escape codes processor
procedure TCustomComTerminal.CreateEscapeCodes;
begin
  if csDesigning in ComponentState then
    Exit;
  case FEmulation of
    teVT52: FEscapeCodes := TEscapeCodesVT52.Create;
    teVT100orANSI: FEscapeCodes := TEscapeCodesVT100.Create;
  else
    begin
      FEscapeCodes := nil;
      DoGetEscapeCodes(FEscapeCodes);
    end;
  end;
end;

// perform screen test
procedure TCustomComTerminal.PerformTest(ACh: Char);
var
  I, J: Integer;
  TermCh: TComTermChar;
begin
  with TermCh do
  begin
    Ch := ACh;
    FrontColor := Font.Color;
    BackColor := Color;
    Underline := False;
  end;
  for I := 1 to FColumns do
    for J := 1 to FRows do
      FBuffer.SetChar(I, J, TermCh);
  Invalidate;
end;

procedure TCustomComTerminal.SetTermAttrColors( FrontColor,BackColor:TColor; AltIntensity,Invert:Boolean);
begin
    FTermAttr.AltIntensity := AltIntensity;
    FTermAttr.Invert := Invert;
    FTermAttr.FrontColor := FrontColor;
    FTermAttr.BackColor := BackColor;
end;

// get current Character properties
function TCustomComTerminal.GetCharAttr: TComTermChar;
begin
  if FTermAttr.AltIntensity then
    Result.FrontColor := FAltColor
  else
    if FTermAttr.Invert then
      Result.FrontColor := FTermAttr.BackColor
    else
      Result.FrontColor := FTermAttr.FrontColor  {Font.Color}; // Warren Fixed!
  if FTermAttr.Invert then begin
    Result.BackColor := FTermAttr.FrontColor
  end else
    Result.BackColor := FTermAttr.BackColor; {Color;}
    
  Result.Underline := FTermAttr.Underline;
  Result.Ch := #0;
end;

// put one Character on screen
procedure TCustomComTerminal.PutChar(Ch: Char);
var
  TermCh: TComTermChar;
begin
  case Ch of
    #8: AdvanceCaret(acBackspace);
    #9: AdvanceCaret(acTab);
    #10, #12: AdvanceCaret(acLineFeed);
    #13: AdvanceCaret(acReturn);
    #32..#255:
      begin
        TermCh := GetCharAttr;
        TermCh.Ch := Ch;
        FBuffer.SetChar(FCaretPos.X, FCaretPos.Y, TermCh);
        DrawChar(FCaretPos.X - FTopLeft.X + 1,
          FCaretPos.Y - FTopLeft.Y + 1, TermCh);
        AdvanceCaret(acChar);
      end;
  end;
  DoChar(Ch);
end;

// init caret
procedure TCustomComTerminal.InitCaret;
begin
  CreateTerminalCaret;
  MoveCaret(FCaretPos.X, FCaretPos.Y);
  ShowCaret;
end;

// restore caret position
procedure TCustomComTerminal.RestoreCaretPos;
begin
  MoveCaret(FSaveCaret.X, FSaveCaret.Y);
end;

// save caret position
procedure TCustomComTerminal.SaveCaretPos;
begin
  FSaveCaret := FCaretPos;
end;

// restore attributes
procedure TCustomComTerminal.RestoreAttr;
begin
  FTermAttr := FSaveAttr;
end;

// save attributes
procedure TCustomComTerminal.SaveAttr;
begin
  FSaveAttr := FTermAttr;
end;

procedure TCustomComTerminal.RxBuf(Sender: TObject; const Buffer:TCPortBytes;
  Count: Integer);
var
  Str: AnsiString;   { Do not change to String. Critical to functionality in Delphi2009! }

  // append line feeds to carriage return
  procedure AppendLineFeeds;
  var
    I: Integer;
  begin
    I := 1;
    while I <= Length(Str) do
    begin
      if Str[I] = Chr(13) then
        Str := Copy(Str, 1, I) + Chr(10) + Copy(Str, I + 1, Length(Str) - I);
      Inc(I);
    end;
  end;

  // convert to 7 bit data
  procedure Force7BitData;
  var
    I: Integer;
  begin
    for I := 1 to Length(Str) do
      Str[I] := AnsiChar(Byte(Str[I]) and $7F); {bugfix}
  end;

begin
  if (Count>RxSanityLimit) then
      exit;
  if Buffer[0]=AnsiChar(0) then begin
      OutputDebugString('nul');
  end;

  // ancient and rather idiom removed:
    SetLength(Str,Count);
    Move(PAnsiChar(Buffer)^,PAnsiChar(Str)^,Count);
    //Move( .... );
 // slightly more modern, but still archaic idiom substituted:
//  SetString( Str,PAnsiChar(Buffer),Count);


  if FAppendLF then
    AppendLineFeeds;
  if FForce7Bit then
    Force7BitData;
  StringReceived(String(Str));
end;

function TCustomComTerminal.GetConnected: Boolean;
begin
  Result := False;
  if FComPort <> nil then
    Result := FComPort.Connected;
end;

procedure TCustomComTerminal.SetConnected(const Value: Boolean);
begin
  if FComPort <> nil then
    FComPort.Connected := Value;
end;

procedure TCustomComTerminal.SetBorderStyle(const Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TCustomComTerminal.SetScrollBars(const Value: TScrollStyle);
begin
  if FScrollBars <> Value then
  begin
    FScrollBars := Value;
    RecreateWnd;
  end;
end;

procedure TCustomComTerminal.SetColumns(const Value: Integer);
begin
  if Value <> FColumns then
  begin
    FColumns := Min(Max(2, Value), 256);
{$IFDEF DELPHI_4_OR_HIGHER}
    AdjustSize;
{$ENDIF}
    UpdateScrollRange;
    if not ((csLoading in ComponentState) or (csDesigning in ComponentState)) then
    begin
      FBuffer.Init;
      Invalidate;
    end;
  end;
end;

procedure TCustomComTerminal.SetRows(const Value: Integer);
begin
  if Value <> FRows then
  begin
    FRows := Min(Max(2, Value), 100);
{$IFDEF DELPHI_4_OR_HIGHER}
    AdjustSize;
{$ENDIF}
    UpdateScrollRange;
    if not ((csLoading in ComponentState) or (csDesigning in ComponentState)) then
    begin
      FBuffer.Init;
      Invalidate;
    end;
  end;
end;

procedure TCustomComTerminal.SetEmulation(const Value: TTermEmulation);
begin
  if FEmulation <> Value then
  begin
    FEmulation := Value;
    if not (csLoading in ComponentState) then
    begin
      FEscapeCodes.Free;
      CreateEscapeCodes;
    end;
  end;
end;

procedure TCustomComTerminal.SetCaret(const Value: TTermCaret);
begin
  if Value <> FCaret then
  begin
    FCaret := Value;
    if Focused then
    begin
      DestroyCaret;
      InitCaret;
    end;
  end;
end;

procedure TCustomComTerminal.SetComPort(const Value: TCustomComPort);
begin
  if Value <> FComPort then
  begin
    if FComPort <> nil then
      FComPort.UnRegisterLink(FComLink);
    FComPort := Value;
    if FComPort <> nil then
    begin
      FComPort.FreeNotification(Self);
      FComPort.RegisterLink(FComLink);
    end;
  end;
end;

procedure TCustomComTerminal.SetAltColor(const Value: TColor);
begin
  if FAltColor <> Value then
  begin
    FAltColor := Value;
    if csDesigning in ComponentState then
      Invalidate;
  end;
end;

initialization
  // initialize default terminal font
  ComTerminalFont := TFont.Create;
  ComTerminalFont.Name := 'Fixedsys';
  ComTerminalFont.Color := clWhite;
  ComTerminalFont.Size := 9;

finalization
  ComTerminalFont.Free;

end.