emulvt.pas

ics Internet 控件

{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Program:      EMULVT.PAS
Description:  Delphi component which does Ansi terminal emulation
              Not every escape sequence is implemented, but a large subset.
Author:       Fran鏾is PIETTE
Creation:     May, 1996
Version:      2.20
EMail:        http://www.overbyte.be       [e-mail]
              http://www.rtfm.be/fpiette   [e-mail]
              [e-mail]
Support:      Use the mailing list [e-mail]
              Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1997-2004 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: [phone]
              <[e-mail]><[e-mail]>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

Updates:
Jul 22, 1997  Some optimization
              Adapted to Delphi 3
Sep 05, 1997  Version 2.01
Dec 16, 1997  V2.02 Corrected a bug int the paint routine which caused GDI
                    resource leak when color was used.
Feb 24, 1998  V2.03 Added AddFKey function
Jul 15, 1998  V2.04 Adapted to Delphi 4 (moved DoKeyBuffer to protected section)
Dec 04, 1998  V2.05 Added 'single char paint' and 'char zoom' features.
Dec 09, 1998  V2.10 Added graphic char drawing using graphic primitives
                    Added (with permission) scroll back code developed by Steve
                    Endicott <[e-mail]>
Dec 21, 1998  V2.11 Corrected some screen update problems related to scrollback.
                    Added fixes from Steve Endicott.
                    Beautified code.
Mar 14, 1999  V2.12 Added OnKeyDown event.
                    Corrected a missing band at right of screen when painting.
Aug 15, 1999  V2.13 Moved KeyPress procedure to public section for BCB4 compat.
Aug 20, 1999  V2.14 Added compile time options. Revised for BCB4.
Nov 12, 1999  V2.15 Corrected display attribute error in delete line.
                    Checked for range in SetLines/GetLine
Aug 09, 2000  V2.16 Wilfried Mestdagh" <[e-mail]> and
                    Steve Endicott <[e-mail]> corrected a
                    bug related to scroll back buffer. See WM + SE 09/08/00
                    tags in code.
Jul 28, 2001  V2.17 Made FCharPos and FLinePos member variables instead of
                    global to avoid conflict when sevaral components are used
                    simultaneously. Suggested by Jeroen Cranendonk
                    <[e-mail]>
Jan 03, 2002  V2.19 Don't adjust scroll bar if not visible
                    Make properties with TopMargin, LeftMargin, RightMargin,
                    BottomMargin.
Jan 10, 2002  V2.19 Fixed SetLineHeight to fill FLinePos up to last item.
May 31, 2004  V2.20 Used ICSDEFS.INC


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit EmulVT;

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$X+}           { Enable extended syntax              }
{$I ICSDEFS.INC}
{$IFDEF DELPHI6_UP}
    {$WARN SYMBOL_PLATFORM   OFF}
    {$WARN SYMBOL_LIBRARY    OFF}
    {$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}
{$IFNDEF VER80}   { Not for Delphi 1                    }
    {$H+}         { Use long strings                    }
    {$J+}         { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF BCB3_UP}
    {$ObjExportAll On}
{$ENDIF}

interface

{$DEFINE SINGLE_CHAR_PAINT}
{$DEFINE CHAR_ZOOM}

uses
    Messages,
{$IFDEF USEWINDOWS}
    Windows,
{$ELSE}
    WinTypes, WinProcs,
{$ENDIF}
    SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ClipBrd;

const
  EmulVTVersion      = 219;
  CopyRight : String = ' TEmulVT (c) 1996-2004 F. Piette V2.20 ';
  MAX_ROW            = 50; 
  MAX_COL            = 160;
  NumPaletteEntries  = 16;

type
  TBackColors     = (vtsBlack, vtsRed,     vtsGreen, vtsYellow,
                     vtsBlue,  vtsMagenta, vtsCyan,  vtsWhite);

  TScreenOption   = (vtoBackColor, vtoCopyBackOnClear);
  TScreenOptions  = set of TScreenOption;
  TXlatTable      = array [0..255] of char;
  PXlatTable      = ^TXlatTable;
  TFuncKeyValue   = String[50];
  PFuncKeyValue   = ^TFuncKeyValue;
  TFuncKey        = record
                        ScanCode : Char;
                        Shift    : TShiftState;
                        Ext      : Boolean;
                        Value    : TFuncKeyValue;
                    end;
  TFuncKeysTable  = array [0..63] of TFuncKey;
  PFuncKeysTable  = ^TFuncKeysTable;
  TKeyBufferEvent = procedure (Sender : TObject; Buffer : PChar; Len : Integer) of object;
  TKeyDownEvent   = procedure (Sender        : TObject;
                               var VirtKey   : Integer;
                               var Shift     : TShiftState;
                               var ShiftLock : Boolean;
                               var ScanCode  : Char;
                               var Ext       : Boolean) of object;


type
  { TLine is an object used to hold one line of text on screen }
  TLine = class(TObject)
  public
    Txt : array [0..MAX_COL] of Char;
    Att : array [0..MAX_COL] of Byte;
    constructor Create;
    procedure   Clear(Attr : Byte);
  end;
  TLineArray      = array [0..16382] of TLine;
  PLineArray      = ^TLineArray;

  { TScreen is an object to hold an entire screen of line and handle }
  { Ansi escape sequences to update this virtual screen              }
  TScreen = class(TObject)
  public
    FLines           : PLineArray;
    FRow             : Integer;
    FCol             : Integer;
    FRowSaved        : Integer;
    FColSaved        : Integer;
    FScrollRowTop    : Integer;
    FScrollRowBottom : Integer;
    FAttribute       : Byte;
    FForceHighBit    : Boolean;
    FReverseVideo    : Boolean;
    FUnderLine       : Boolean;
    FRowCount        : Integer;
    FColCount        : Integer;
    FBackRowCount    : Integer;
    FBackEndRow      : Integer;
    FBackColor       : TBackColors;
    FOptions         : TScreenOptions;
    FEscBuffer       : String[80];
    FEscFlag         : Boolean;
    Focused          : Boolean;
    FAutoLF          : Boolean;
    FAutoCR          : Boolean;
    FAutoWrap        : Boolean;
    FCursorOff       : Boolean;
    FCKeyMode        : Boolean;
    FNoXlat          : Boolean;
    FNoXlatInitial   : Boolean;
    FCntLiteral      : Integer;
    FCarbonMode      : Boolean;
    FXlatInputTable  : PXlatTable;
    FXlatOutputTable : PXlatTable;
    FCharSetG0       : Char;
    FCharSetG1       : Char;
    FCharSetG2       : Char;
    FCharSetG3       : Char;
    FAllInvalid      : Boolean;
    FInvRect         : TRect;
    FOnCursorVisible : TNotifyEvent;
    constructor Create;
    destructor  Destroy; override;
    procedure   AdjustFLines(NewCount : Integer);
    procedure   CopyScreenToBack;
    procedure   SetRowCount(NewCount : Integer);
    procedure   SetBackRowCount(NewCount : Integer);
    procedure   InvRect(nRow, nCol : Integer);
    procedure   InvClear;
    procedure   SetLines(I : Integer; Value : TLine);
    function    GetLines(I : Integer) : TLine;
    procedure   WriteChar(Ch : Char);
    procedure   WriteStr(Str : String);
    function    ReadStr : String;
    procedure   GotoXY(X, Y : Integer);
    procedure   WriteLiteralChar(Ch : Char);
    procedure   ProcessEscape(EscCmd : Char);
    procedure   SetAttr(Att : Char);
    procedure   CursorRight;
    procedure   CursorLeft;
    procedure   CursorDown;
    procedure   CursorUp;
    procedure   CarriageReturn;
    procedure   ScrollUp;
    procedure   ScrollDown;
    procedure   ClearScreen;
    procedure   BackSpace;
    procedure   Eol;
    procedure   Eop;
    procedure   ProcessESC_D;                { Index                   }
    procedure   ProcessESC_M;                { Reverse index           }
    procedure   ProcessESC_E;                { Next line               }
    procedure   ProcessCSI_u;                { Restore Cursor          }
    procedure   ProcessCSI_I;                { Select IBM char set     }
    procedure   ProcessCSI_J;                { Clear the screen        }
    procedure   ProcessCSI_K;                { Erase to End of Line    }
    procedure   ProcessCSI_L;                { Insert Line             }
    procedure   ProcessCSI_M;                { Delete Line             }
    procedure   ProcessCSI_m_lc;             { Select Attributes       }
    procedure   ProcessCSI_n_lc;             { Cursor position report  }
    procedure   ProcessCSI_at;               { Insert character        }
    procedure   ProcessCSI_r_lc;             { Scrolling margins       }
    procedure   ProcessCSI_s_lc;             { Save cursor location    }
    procedure   ProcessCSI_u_lc;             { Restore cursor location }
    procedure   ProcessCSI_7;                { Save cursor location    }
    procedure   ProcessCSI_8;                { Restore cursor location }
    procedure   ProcessCSI_H;                { Set Cursor Position     }
    procedure   ProcessCSI_h_lc;             { Terminal mode set       }
    procedure   ProcessCSI_l_lc;             { Terminal mode reset     }
    procedure   ProcessCSI_A;                { Cursor Up               }
    procedure   ProcessCSI_B;                { Cursor Down             }
    procedure   ProcessCSI_C;                { Cursor Right            }
    procedure   ProcessCSI_D;                { Cursor Left             }
    procedure   ProcessCSI_P;                { Delete Character        }
    procedure   ProcessCSI_S;                { Scroll up               }
    procedure   ProcessCSI_T;                { Scroll down             }
    procedure   process_charset_G0(EscCmd : Char);{ G0 character set   }
    procedure   process_charset_G1(EscCmd : Char);{ G1 character set   }
    procedure   process_charset_G2(EscCmd : Char);{ G2 character set   }
    procedure   process_charset_G3(EscCmd : Char);{ G3 character set   }
    procedure   UnimplementedEscape(EscCmd : Char);
    procedure   InvalidEscape(EscCmd : Char);
    function    GetEscapeParam(From : Integer; var Value : Integer) : Integer;
    property    OnCursorVisible : TNotifyEvent read  FonCursorVisible
                                               write FOnCursorVisible;
    property    Lines[I : Integer] : TLine read GetLines write SetLines;
  end;

  { TCustomEmulVT is an visual component wich does the actual display }
  { of a TScreen object wich is the virtual screen                    }
  { No property is published. See TEmulVT class                       }
  TCustomEmulVT = class(TCustomControl)
  private
    FCharPos         : array [0..MAX_COL + 1] of integer;
    FLinePos         : array [0..MAX_ROW + 1] of integer;
    FFileHandle      : TextFile;
    FCursorVisible   : Boolean;
    FCaretShown      : Boolean;
    FCaretCreated    : Boolean;
    FLineHeight      : Integer;
    FLineZoom        : Single;
    FCharWidth       : Integer;
    FCharZoom        : Single;
    FGraphicDraw     : Boolean;
    FInternalLeading : Integer;
    FBorderStyle     : TBorderStyle;
    FBorderWidth     : Integer;
    FAutoRepaint     : Boolean;
    FFont            : TFont;
    FVScrollBar      : TScrollBar;
    FTopLine         : Integer;
    FLocalEcho       : Boolean;
    FOnKeyBuffer     : TKeyBufferEvent;
    FOnKeyDown       : TKeyDownEvent;
    FFKeys           : Integer;
    FMonoChrome      : Boolean;
    FLog             : Boolean;
    FAppOnMessage    : TMessageEvent;
    FFlagCirconflexe : Boolean;
    FFlagTrema       : Boolean;
    FSelectRect      : TRect;
    FTopMargin       : Integer;
    FLeftMargin      : Integer;
    FRightMargin     : Integer;
    FBottomMargin    : Integer;
    FPal             : HPalette;
    FPaletteEntries  : array[0..NumPaletteEntries - 1] of TPaletteEntry;
    FMarginColor     : Integer;
    procedure   WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure   WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure   WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure   WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure   WMPaletteChanged(var Message : TMessage); message WM_PALETTECHANGED;
    procedure   VScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);