adterm.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 ***** *)

{*********************************************************}
{*                    ADTERM.PAS 4.06                    *}
{*********************************************************}
{* Deprecated terminal (TApdTerminal)                    *}
{*********************************************************}

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

{Options required for this unit}
{$I+,G+,X+,F+}
{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}

unit AdTerm;
  {-Delphi terminal window component}

interface

uses
  WinTypes,
  WinProcs,
  SysUtils,
  Classes,
  Messages,
  Controls,
  StdCtrls,
  Forms,
  Graphics,
  Dialogs,
  OoMisc,
  AwUser,
  AwEmu,
  AwKeyEmu,
  AwTerm,
  AdExcept,
  AdPort,
  AdProtcl;

const
  {ANSI color constants}
  emBlack       = 0;
  emRed         = 1;
  emGreen       = 2;
  emYellow      = 3;
  emBlue        = 4;
  emMagenta     = 5;
  emCyan        = 6;
  emWhite       = 7;
  emBlackBold   = 8;
  emRedBold     = 9;
  emGreenBold   = 10;
  emYellowBold  = 11;
  emBlueBold    = 12;
  emMagentaBold = 13;
  emCyanBold    = 14;
  emWhiteBold   = 15;

const
  {Emulator commands}
  eNone            = 0;       {No command, ignore this char}
  eChar            = 1;       {No command, process the char}
  eGotoXY          = 2; {X}   {Absolute goto cursor position call}
  eUp              = 3; {X}   {Cursor up}
  eDown            = 4; {X}   {Cursor down}
  eRight           = 5; {X}   {Cursor right}
  eLeft            = 6; {X}   {Cursor left}
  eClearBelow      = 7; {R}   {Clear screen below cursor}
  eClearAbove      = 8; {R}   {Clear screen above cursor}
  eClearScreen     = 9; {R}   {Clear entire screen}
  eClearEndofLine  = 10;{R}   {Clear from cursor to end of line}
  eClearStartOfLine= 11;{R}   {Clear from cursor to the start of line}
  eClearLine       = 12;{R}   {Clear entire line that cursor is on}
  eSetMode         = 13;{X}   {Set video mode}
  eSetBackground   = 14;      {Set background attribute}
  eSetForeground   = 15;      {Set foreground attribute}
  eSetAttribute    = 16;{X}   {Set video attribute (foreground and background)}
  eSaveCursorPos   = 17;      {Save cursor position}
  eRestoreCursorPos= 18;      {Restore cursor position}
  eDeviceStatusReport = 19;{X}{Report device status or cursor position}
  eString          = 20;      {Pascal style string}
  eHT              = 21;      {Horizontal Tab Character}
  eError           = 255;     {indicates a parser error}

type
  {For setting auto-scrollbar behavior}
  TAutoScroll = (asNone, asHorizontal, asVertical, asBoth);
  TIntegralSize = (isNone, isWidth, isHeight, isBoth);

  {Emulator types}
  TEmulatorType = (etNone, etANSI, etVT52, etVT100, etANSIBBS);

  {Capture mode}
  TCaptureMode = (cmOff, cmOn, cmAppend);

  {Status event handler}
  TTerminalStatusEvent = procedure(CP : TObject;
                                   Row, Col : Byte;
                                   BufRow, BufCol : Word) of object;

  TTerminalErrorEvent = procedure(CP : TObject;
                                  ErrorCode: Word) of object;

  TTerminalCursorPosReportEvent = procedure(CP : TObject;
                                            XPos, YPos: Integer) of object;

  TTermAttrLine = array[0..MaxCols-1] of Byte;

const
  {Default emulator property values}
  {$IFNDEF AProBCB}
  adtDefEmuData     = nil;
  adtDefComPort     = nil;
  adtDefEmulator    = nil;
  adtDefTermSave    = nil;
  adtDefControlStyles = [csClickEvents, csSetCaption, csFramed, csDoubleClicks]; 
  {$ENDIF}
  adtDefEmulatorType = etAnsi;

  adtDefWidth       = 200;
  adtDefHeight      = 200;
  adtDefTermTabStop = True; {Was "DefTabStop"}                   
  adtDefParentColor = False;
  adtDefParentFont  = False;
  adtDefStyle       = 0;
  adtDefScrollBars  = ssNone;
  adtDefAutoScroll  = asNone;
  adtDefIntegralSize = isBoth;
  adtDefScrollback  = False;
  adtDefActive      = True;
  adtDefColor       = clBlack;
  adtDefFontColor   = clSilver;
  adtDefRows        = 200;
  adtDefColumns     = 80;
  adtDefPageHeight  = 25;
  adtDefDisplayRows = 15;
  adtDefDisplayColumns = 40;
  adtDefCapture     = cmOff;
  adtDefCaptureFile = 'APD.CAP';
  adtDefFontName    = 'Terminal';
  adtDefWantTabs    = True;
  adtDefBPlusTriggers = False;
  adtDefBlinkTime     = 550;
  adtDefPersistentMark = True;
  adtDefHalfDuplex     = False;

const
  DefKeyEmuEnabled         = False;
  DefKeyEmuProcessAll      = False;
  DefKeyEmuProcessExtended = False;
  DefKeyEmuFilename        = 'AWKEYBRD.INI';

type
  {record type used to describe a command and its parameters}
  TEmuCommand = record
    Ch      : Char;                 {Character}
    Cmd     : Byte;                 {Command}
    X, Y    : Byte;                 {Coordinates}
    FColor  : Byte;                 {Foreground color}
    BColor  : Byte;                 {Background color}
    ExtAttr : Byte;                 {Extended attributes}
    EmuType : Byte;                 {Emulator Type}
    {BCB cannot handle a small string in a variant record}
    case Byte of
      1 : (Other  : array[1..MaxOther] of Byte);  {Other data}
    {$IFDEF AProBCB}
      2 : (OtherStrLen : Byte;
           OtherStr  : array[1..10] of Char);  {Other data}
    {$ELSE}
      2 : (OtherStr : String[10]);
    {$ENDIF}
  end;

  {Emulator callback function type}
  TProcessCharProc = procedure(PAnsiEmulator: Pointer; C: Char;
                               var Command: TEmuCommand);

  TKeyEmuCommand = record
    KeyCode       : Word;
    ShiftMap      : Word;
    ToggleMap     : Word;
    Extended      : Bool;
    KeyMapped     : Bool;
    KeyboardState : TKeyBoardState;
    Value         : string[KeyMappingLen];
  end;

  TProcessKeyProc = procedure(PKeyEmulator: Pointer; Key: Word;
                              var Command: TKeyEmuCommand);

  TApdCustomKeyboardEmulator = class(TApdBaseComponent)
  protected {private}
    FKeyEmuInUse           : Boolean;
    FKeyEmuData            : Pointer;
    FKeyEmuProc            : TProcessKeyProc;
    FEnabled               : Boolean;
    FKeyEmuType            : String;
    FKeyEmuFileName        : String;
    FKeyEmuProcessAllKeys  : Boolean;
    FKeyEmuProcessExtended : Boolean;
    FKeyEmuTypeList        : TStringList;
  protected
    procedure SetEnabled(const Value: Boolean);
    procedure SetFileName(const Value: String);
    procedure SetKeyEmuData(const NewKeyEmu : Pointer);
    procedure SetKeyEmuProc(const NewKeyProc : TProcessKeyProc);
    procedure SetKeyEmuType(const Value: String);
    procedure SetProcessAll(const Value: Boolean);
    procedure SetProcessExt(const Value: Boolean);
    function GetProcessExt: Boolean;
    function GetProcessAll: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property KeyEmuData : Pointer
      read FKeyEmuData write SetKeyEmuData;
    property KeyEmuProc : TProcessKeyProc
      read FKeyEmuProc write SetKeyEmuProc;
    property KeyEmuInUse : Boolean
      read FKeyEmuInUse write FKeyEmuInUse;

    property Enabled : Boolean
      read FEnabled write SetEnabled;
    property MapFileName : String
      read FKeyEmuFileName write SetFileName;
    property EmulatorType : String
      read FKeyEmuType write SetKeyEmuType;
    property ProcessAllKeys : Boolean
      read GetProcessAll write SetProcessAll;
    property ProcessExtended : Boolean
      read GetProcessExt write SetProcessExt;
    property KeyEmuTypeList : TStringList
      read FKeyEmuTypeList;
  end;

  TApdKeyboardEmulator = class(TApdCustomKeyboardEmulator)
  published
    property Enabled;
    property MapFileName;
    property EmulatorType;
    property ProcessAllKeys;
    property ProcessExtended;
  end;

  {Emulator process char event}
  TProcessCharEvent = procedure(CP : TObject;
                                C : Char;
                                var Command : TEmuCommand) of object;

  {The base emulator component}
  TApdCustomEmulator = class(TApdBaseComponent)
  protected {private}
    {.Z+}
    FEmuInUse      : Boolean;
    FEmuData       : Pointer;
    FEmuProc       : TProcessCharProc;
    FEmulatorType  : TEmulatorType;
    FOnProcessChar : TProcessCharEvent;

  protected
    procedure SetEmuData(NewEmu : Pointer);
    procedure SetEmuProc(NewProc : TProcessCharProc);
    procedure SetEmulatorType(const NewEmulatorType : TEmulatorType);
    procedure Loaded; override;
    procedure ProcessChar(C : Char; var Command : TEmuCommand); virtual;

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

    property EmulatorType : TEmulatorType
      read FEmulatorType write SetEmulatorType default adtDefEmulatorType;
    property OnProcessChar : TProcessCharEvent
      read FOnProcessChar write FOnProcessChar;
    property EmuData : Pointer
      read FEmuData write SetEmuData;
    property EmuProc : TProcessCharProc
      read FEmuProc write SetEmuProc;
    property EmuInUse : Boolean
      read FEmuInUse write FEmuInUse;
  end;

  {The emulator component}
  TApdEmulator = class(TApdCustomEmulator)
  published
    property EmulatorType;
    property OnProcessChar;
  end;

  {The base terminal window component}
  TApdCustomTerminal = class(TApdBaseWinControl)
  protected {private}
    {.Z+}
    {Misc}
    TermSave      : Pointer;
    Created       : Boolean;
    ActivePending : Boolean;
    Force         : Boolean;
    WasFullWidth  : Boolean;
    PixelWidth    : Word;
    InRecreate    : Boolean;
    TermBuff      : TTermBuff;

    {Property fields}
    FComPort      : TApdCustomComPort;
    FStyle        : LongInt;
    FScrollBars   : TScrollStyle;
    FAutoScroll   : TAutoScroll;
    FIntegralSize : TIntegralSize;
    FScrollBack   : Boolean;
    FActive       : Boolean;
    FEmulator     : TApdCustomEmulator;
    FRows         : Word;
    FColumns      : Word;
    FPageHeight   : Word;
    FDisplayRows  : Word;
    FDisplayColumns : Word;
    FCaptureFile  : ShortString;
    FCapture      : TCaptureMode;
    FKeyBoardEmu  : TApdKeyboardEmulator;
    FOnTerminalStatus  : TTerminalStatusEvent;
    FOnTerminalError   : TTerminalErrorEvent;
    FOnCursorPosReport : TTerminalCursorPosReportEvent;
    FBlinkTime    : Word;
    FPersistentMark    : Boolean;
    FHalfDuplex   : Boolean;

    {Colors}
    ColorMap      : TAnsiColorMap;

    {Private procedures}
    procedure StuffDesignData;
    procedure SetComPort(const NewComPort : TApdCustomComPort);
    procedure SetEmulator(const NewEmulator : TApdCustomEmulator);
    procedure SetKeyboardEmu(const NewKeyEmulator : TApdKeyboardEmulator);
    procedure SetName(const Value: TComponentName); override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure ResetTermBuffer;

    {Font procedures}
    procedure PassFont;
    procedure CMFontChanged(var Message : TMessage); message CM_FONTCHANGED;

    {Color procedures}
    function ColorIndex(const RGB : TColor) : Integer;
    function CurrentColor(const Back : Boolean) : Integer;
    procedure GetColorMap;
    procedure SetColorMap;
    procedure PassColors;
    procedure CMColorChanged(var Message : TMessage); message CM_COLORCHANGED;

    {Open/close messages}
    procedure PortOpen(var Message : TMessage); message APW_PORTOPEN;
    procedure PortClose(var Message : TMessage); message APW_PORTCLOSE;

    {Terminal activation}
    function StartTerminalPrim(UseExcept : Boolean) : Integer;
    procedure StartTerminal; dynamic;
    function StopTerminalPrim(UseExcept : Boolean) : Integer;
    procedure StopTerminal; dynamic;

  protected
    {Property methods}
    procedure CreateWnd; override;
    procedure CreateParams(var Params: TCreateParams); override;

    procedure SetScrollBars(const NewScroll : TScrollStyle);
    procedure SetAutoScroll(const NewScroll : TAutoScroll);
    procedure SetIntegralSize(const NewInt : TIntegralSize);
    procedure SetScrollback(const NewScroll : Boolean);
    procedure SetActive(const NewActive : Boolean);
    procedure SetRows(const NewRows : Word);
    procedure SetColumns(const NewColumns : Word);
    procedure SetPageHeight(const NewPageHeight : Word);
    function GetDisplayRows : Word;
    procedure SetDisplayRows(const NewRows : Word);
    function GetDisplayColumns : Word;
    procedure SetDisplayColumns(const NewColumns : Word);
    function GetWantTabs : Boolean;
    procedure SetWantTabs(const NewTabs : Boolean);
    function GetHeight : Integer;
    procedure SetHeight(const NewHeight : Integer);
    function GetWidth : Integer;
    procedure SetWidth(const NewWidth : Integer);
    function getCharWidth : Byte; {change to lower case g for BCB}
    function getCharHeight : Byte; {change to lower case g for BCB}
    procedure SetCapture(const NewCapture : TCaptureMode);