![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to emulvt.pas CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Synchronet] / sbbs / sbbs3 / ctrl|
Return to emulvt.pas CVS log | Up to [Synchronet] / sbbs / sbbs3 / ctrl |
1.1 ! root 1: {*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! 2: ! 3: Program: EMULVT.PAS ! 4: Description: Delphi component which does Ansi terminal emulation ! 5: Not every escape sequence is implemented, but a large subset. ! 6: Author: Fran�ois PIETTE ! 7: EMail: http://users.swing.be/francois.piette [email protected] ! 8: http://www.rtfm.be/fpiette [email protected] ! 9: [email protected] ! 10: Creation: May, 1996 ! 11: Version: 2.16 ! 12: Support: Use the mailing list [email protected] See website for details. ! 13: Legal issues: Copyright (C) 1997-2000 by Fran�ois PIETTE ! 14: Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56 ! 15: <[email protected]> ! 16: ! 17: This software is provided 'as-is', without any express or ! 18: implied warranty. In no event will the author be held liable ! 19: for any damages arising from the use of this software. ! 20: ! 21: Permission is granted to anyone to use this software for any ! 22: purpose, including commercial applications, and to alter it ! 23: and redistribute it freely, subject to the following ! 24: restrictions: ! 25: ! 26: 1. The origin of this software must not be misrepresented, ! 27: you must not claim that you wrote the original software. ! 28: If you use this software in a product, an acknowledgment ! 29: in the product documentation would be appreciated but is ! 30: not required. ! 31: ! 32: 2. Altered source versions must be plainly marked as such, and ! 33: must not be misrepresented as being the original software. ! 34: ! 35: 3. This notice may not be removed or altered from any source ! 36: distribution. ! 37: ! 38: 4. You must register this software by sending a picture postcard ! 39: to the author. Use a nice stamp and mention your name, street ! 40: address, EMail address and any comment you like to say. ! 41: ! 42: Updates: ! 43: Jul 22, 1997 Some optimization ! 44: Adapted to Delphi 3 ! 45: Sep 05, 1997 Version 2.01 ! 46: Dec 16, 1997 V2.02 Corrected a bug int the paint routine which caused GDI ! 47: resource leak when color was used. ! 48: Feb 24, 1998 V2.03 Added AddFKey function ! 49: Jul 15, 1998 V2.04 Adapted to Delphi 4 (moved DoKeyBuffer to protected section) ! 50: Dec 04, 1998 V2.05 Added 'single char paint' and 'char zoom' features. ! 51: Dec 09, 1998 V2.10 Added graphic char drawing using graphic primitives ! 52: Added (with permission) scroll back code developed by Steve ! 53: Endicott <[email protected]> ! 54: Dec 21, 1998 V2.11 Corrected some screen update problems related to scrollback. ! 55: Added fixes from Steve Endicott. ! 56: Beautified code. ! 57: Mar 14, 1999 V2.12 Added OnKeyDown event. ! 58: Corrected a missing band at right of screen when painting. ! 59: Aug 15, 1999 V2.13 Moved KeyPress procedure to public section for BCB4 compat. ! 60: Aug 20, 1999 V2.14 Added compile time options. Revised for BCB4. ! 61: Nov 12, 1999 V2.15 Corrected display attribute error in delete line. ! 62: Checked for range in SetLines/GetLine ! 63: Aug 09, 2000 V2.16 Wilfried Mestdagh" <[email protected]> and ! 64: Steve Endicott <[email protected]> corrected a ! 65: bug related to scroll back buffer. See WM + SE 09/08/00 ! 66: tags in code. ! 67: ! 68: * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 69: unit Emulvt; ! 70: ! 71: {$B-} { Enable partial boolean evaluation } ! 72: {$T-} { Untyped pointers } ! 73: {$X+} { Enable extended syntax } ! 74: {$IFNDEF VER80} { Not for Delphi 1 } ! 75: {$H+} { Use long strings } ! 76: {$J+} { Allow typed constant to be modified } ! 77: {$ENDIF} ! 78: {$IFDEF VER110} { C++ Builder V3.0 } ! 79: {$ObjExportAll On} ! 80: {$ENDIF} ! 81: {$IFDEF VER125} { C++ Builder V4.0 } ! 82: {$ObjExportAll On} ! 83: {$ENDIF} ! 84: ! 85: interface ! 86: ! 87: {$DEFINE SINGLE_CHAR_PAINT} ! 88: {$DEFINE CHAR_ZOOM} ! 89: ! 90: uses ! 91: SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, ! 92: Forms, Dialogs, StdCtrls, ClipBrd; ! 93: ! 94: const ! 95: EmulVTVersion = 216; ! 96: CopyRight : String = ' TEmulVT (c) 1996-2000 F. Piette V2.16 '; ! 97: MAX_ROW = 50; ! 98: MAX_COL = 132; ! 99: TopMargin = 4; ! 100: LeftMargin = 6; ! 101: RightMargin = 6; ! 102: BottomMargin = 4; ! 103: NumPaletteEntries = 16; ! 104: ! 105: type ! 106: TBackColors = (vtsBlack, vtsRed, vtsGreen, vtsYellow, ! 107: vtsBlue, vtsMagenta, vtsCyan, vtsWhite); ! 108: ! 109: TScreenOption = (vtoBackColor, vtoCopyBackOnClear); ! 110: TScreenOptions = set of TScreenOption; ! 111: TXlatTable = array [0..255] of char; ! 112: PXlatTable = ^TXlatTable; ! 113: TFuncKeyValue = String[50]; ! 114: PFuncKeyValue = ^TFuncKeyValue; ! 115: TFuncKey = record ! 116: ScanCode : Char; ! 117: Shift : TShiftState; ! 118: Ext : Boolean; ! 119: Value : TFuncKeyValue; ! 120: end; ! 121: TFuncKeysTable = array [0..63] of TFuncKey; ! 122: PFuncKeysTable = ^TFuncKeysTable; ! 123: TKeyBufferEvent = procedure (Sender : TObject; Buffer : PChar; Len : Integer) of object; ! 124: TKeyDownEvent = procedure (Sender : TObject; ! 125: var VirtKey : Integer; ! 126: var Shift : TShiftState; ! 127: var ShiftLock : Boolean; ! 128: var ScanCode : Char; ! 129: var Ext : Boolean) of object; ! 130: ! 131: ! 132: type ! 133: { TLine is an object used to hold one line of text on screen } ! 134: TLine = class(TObject) ! 135: public ! 136: Txt : array [0..MAX_COL] of Char; ! 137: Att : array [0..MAX_COL] of Byte; ! 138: constructor Create; ! 139: procedure Clear(Attr : Byte); ! 140: end; ! 141: TLineArray = array [0..16382] of TLine; ! 142: PLineArray = ^TLineArray; ! 143: ! 144: { TScreen is an object to hold an entire screen of line and handle } ! 145: { Ansi escape sequences to update this virtual screen } ! 146: TScreen = class(TObject) ! 147: public ! 148: FLines : PLineArray; ! 149: FRow : Integer; ! 150: FCol : Integer; ! 151: FRowSaved : Integer; ! 152: FColSaved : Integer; ! 153: FScrollRowTop : Integer; ! 154: FScrollRowBottom : Integer; ! 155: FAttribute : Byte; ! 156: FForceHighBit : Boolean; ! 157: FReverseVideo : Boolean; ! 158: FUnderLine : Boolean; ! 159: FRowCount : Integer; ! 160: FColCount : Integer; ! 161: FBackRowCount : Integer; ! 162: FBackEndRow : Integer; ! 163: FBackColor : TBackColors; ! 164: FOptions : TScreenOptions; ! 165: FEscBuffer : String[80]; ! 166: FEscFlag : Boolean; ! 167: Focused : Boolean; ! 168: FAutoLF : Boolean; ! 169: FAutoCR : Boolean; ! 170: FAutoWrap : Boolean; ! 171: FCursorOff : Boolean; ! 172: FCKeyMode : Boolean; ! 173: FNoXlat : Boolean; ! 174: FNoXlatInitial : Boolean; ! 175: FCntLiteral : Integer; ! 176: FCarbonMode : Boolean; ! 177: FXlatInputTable : PXlatTable; ! 178: FXlatOutputTable : PXlatTable; ! 179: FCharSetG0 : Char; ! 180: FCharSetG1 : Char; ! 181: FCharSetG2 : Char; ! 182: FCharSetG3 : Char; ! 183: FAllInvalid : Boolean; ! 184: FInvRect : TRect; ! 185: FOnCursorVisible : TNotifyEvent; ! 186: constructor Create; ! 187: destructor Destroy; override; ! 188: procedure AdjustFLines(NewCount : Integer); ! 189: procedure CopyScreenToBack; ! 190: procedure SetRowCount(NewCount : Integer); ! 191: procedure SetBackRowCount(NewCount : Integer); ! 192: procedure InvRect(nRow, nCol : Integer); ! 193: procedure InvClear; ! 194: procedure SetLines(I : Integer; Value : TLine); ! 195: function GetLines(I : Integer) : TLine; ! 196: procedure WriteChar(Ch : Char); ! 197: procedure WriteStr(Str : String); ! 198: function ReadStr : String; ! 199: procedure GotoXY(X, Y : Integer); ! 200: procedure WriteLiteralChar(Ch : Char); ! 201: procedure ProcessEscape(EscCmd : Char); ! 202: procedure SetAttr(Att : Char); ! 203: procedure CursorRight; ! 204: procedure CursorLeft; ! 205: procedure CursorDown; ! 206: procedure CursorUp; ! 207: procedure CarriageReturn; ! 208: procedure ScrollUp; ! 209: procedure ScrollDown; ! 210: procedure ClearScreen; ! 211: procedure BackSpace; ! 212: procedure Eol; ! 213: procedure Eop; ! 214: procedure ProcessESC_D; { Index } ! 215: procedure ProcessESC_M; { Reverse index } ! 216: procedure ProcessESC_E; { Next line } ! 217: procedure ProcessCSI_u; { Restore Cursor } ! 218: procedure ProcessCSI_I; { Select IBM char set } ! 219: procedure ProcessCSI_J; { Clear the screen } ! 220: procedure ProcessCSI_K; { Erase to End of Line } ! 221: procedure ProcessCSI_L; { Insert Line } ! 222: procedure ProcessCSI_M; { Delete Line } ! 223: procedure ProcessCSI_m_lc; { Select Attributes } ! 224: procedure ProcessCSI_n_lc; { Cursor position report } ! 225: procedure ProcessCSI_at; { Insert character } ! 226: procedure ProcessCSI_r_lc; { Scrolling margins } ! 227: procedure ProcessCSI_s_lc; { Save cursor location } ! 228: procedure ProcessCSI_u_lc; { Restore cursor location } ! 229: procedure ProcessCSI_7; { Save cursor location } ! 230: procedure ProcessCSI_8; { Restore cursor location } ! 231: procedure ProcessCSI_H; { Set Cursor Position } ! 232: procedure ProcessCSI_h_lc; { Terminal mode set } ! 233: procedure ProcessCSI_l_lc; { Terminal mode reset } ! 234: procedure ProcessCSI_A; { Cursor Up } ! 235: procedure ProcessCSI_B; { Cursor Down } ! 236: procedure ProcessCSI_C; { Cursor Right } ! 237: procedure ProcessCSI_D; { Cursor Left } ! 238: procedure ProcessCSI_P; { Delete Character } ! 239: procedure ProcessCSI_S; { Scroll up } ! 240: procedure ProcessCSI_T; { Scroll down } ! 241: procedure process_charset_G0(EscCmd : Char);{ G0 character set } ! 242: procedure process_charset_G1(EscCmd : Char);{ G1 character set } ! 243: procedure process_charset_G2(EscCmd : Char);{ G2 character set } ! 244: procedure process_charset_G3(EscCmd : Char);{ G3 character set } ! 245: procedure UnimplementedEscape(EscCmd : Char); ! 246: procedure InvalidEscape(EscCmd : Char); ! 247: function GetEscapeParam(From : Integer; var Value : Integer) : Integer; ! 248: property OnCursorVisible : TNotifyEvent read FonCursorVisible ! 249: write FOnCursorVisible; ! 250: property Lines[I : Integer] : TLine read GetLines write SetLines; ! 251: end; ! 252: ! 253: { TCustomEmulVT is an visual component wich does the actual display } ! 254: { of a TScreen object wich is the virtual screen } ! 255: { No property is published. See TEmulVT class } ! 256: TCustomEmulVT = class(TCustomControl) ! 257: private ! 258: FScreen : TScreen; ! 259: FFileHandle : TextFile; ! 260: FCursorVisible : Boolean; ! 261: FCaretShown : Boolean; ! 262: FCaretCreated : Boolean; ! 263: FLineHeight : Integer; ! 264: FLineZoom : Single; ! 265: FCharWidth : Integer; ! 266: FCharZoom : Single; ! 267: FGraphicDraw : Boolean; ! 268: FInternalLeading : Integer; ! 269: FBorderStyle : TBorderStyle; ! 270: FBorderWidth : Integer; ! 271: FAutoRepaint : Boolean; ! 272: FFont : TFont; ! 273: FVScrollBar : TScrollBar; ! 274: FTopLine : Integer; ! 275: FLocalEcho : Boolean; ! 276: FOnKeyBuffer : TKeyBufferEvent; ! 277: FOnKeyDown : TKeyDownEvent; ! 278: FFKeys : Integer; ! 279: FMonoChrome : Boolean; ! 280: FLog : Boolean; ! 281: FAppOnMessage : TMessageEvent; ! 282: FFlagCirconflexe : Boolean; ! 283: FFlagTrema : Boolean; ! 284: FSelectRect : TRect; ! 285: FPal : HPalette; ! 286: FPaletteEntries : array[0..NumPaletteEntries - 1] of TPaletteEntry; ! 287: procedure WMPaint(var Message: TWMPaint); message WM_PAINT; ! 288: procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; ! 289: procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS; ! 290: procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; ! 291: procedure WMPaletteChanged(var Message : TMessage); message WM_PALETTECHANGED; ! 292: procedure VScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); ! 293: procedure SetCaret; ! 294: procedure AdjustScrollBar; ! 295: function ProcessFKeys(ScanCode: Char; Shift: TShiftState; Ext: Boolean) : Boolean; ! 296: function FindFKeys(ScanCode: Char; Shift: TShiftState; ! 297: Ext: Boolean) : PFuncKeyValue; ! 298: procedure CursorVisibleEvent(Sender : TObject); ! 299: procedure SetFont(Value : TFont); ! 300: procedure SetAutoLF(Value : Boolean); ! 301: procedure SetAutoCR(Value : Boolean); ! 302: procedure SetXlat(Value : Boolean); ! 303: procedure SetLog(Value : Boolean); ! 304: procedure SetRows(Value : Integer); ! 305: procedure SetCols(Value : Integer); ! 306: procedure SetBackRows(Value : Integer); ! 307: procedure SetTopLine(Value : Integer); ! 308: procedure SetBackColor(Value : TBackColors); ! 309: procedure SetOptions(Value : TScreenOptions); ! 310: procedure SetLineHeight(Value : Integer); ! 311: function GetAutoLF : Boolean; ! 312: function GetAutoCR : Boolean; ! 313: function GetXlat : Boolean; ! 314: function GetRows : Integer; ! 315: function GetCols : Integer; ! 316: function GetBackRows : Integer; ! 317: function GetBackColor : TBackColors; ! 318: function GetOptions : TScreenOptions; ! 319: protected ! 320: procedure AppMessageHandler(var Msg: TMsg; var Handled: Boolean); ! 321: procedure DoKeyBuffer(Buffer : PChar; Len : Integer); virtual; ! 322: procedure PaintGraphicChar(DC : HDC; ! 323: X, Y : Integer; ! 324: rc : PRect; ! 325: ch : Char); ! 326: public ! 327: constructor Create(AOwner: TComponent); override; ! 328: destructor Destroy; override; ! 329: procedure ShowCursor; ! 330: procedure SetCursor(Row, Col : Integer); ! 331: procedure WriteChar(Ch : Char); ! 332: procedure WriteStr(Str : String); ! 333: procedure WriteBuffer(Buffer : Pointer; Len : Integer); ! 334: function ReadStr : String; ! 335: procedure CopyHostScreen; ! 336: procedure Clear; ! 337: procedure UpdateScreen; ! 338: function SnapPixelToRow(Y : Integer) : Integer; ! 339: function SnapPixelToCol(X : Integer) : Integer; ! 340: function PixelToRow(Y : Integer) : Integer; ! 341: function PixelToCol(X : Integer) : Integer; ! 342: procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint); ! 343: procedure SetLineZoom(newValue : Single); ! 344: procedure SetCharWidth(newValue : Integer); ! 345: procedure SetCharZoom(newValue : Single); ! 346: procedure KeyPress(var Key: Char); override; ! 347: property LineZoom : Single read FLineZoom write SetLineZoom; ! 348: property CharWidth : Integer read FCharWidth write SetCharWidth; ! 349: property CharZoom : Single read FCharZoom write SetCharZoom; ! 350: property GraphicDraw : Boolean read FGraphicDraw write FGraphicDraw; ! 351: property TopLine : Integer read FTopLine write SetTopLine; ! 352: property VScrollBar : TScrollBar read FVScrollBar; ! 353: private ! 354: procedure PaintOneLine(DC: HDC; Y, Y1 : Integer; const Line : TLine; ! 355: nColFrom : Integer; nColTo : Integer); ! 356: procedure SetupFont; ! 357: property Text : String read ReadStr write WriteStr; ! 358: property OnMouseMove; ! 359: property OnMouseDown; ! 360: property OnMouseUp; ! 361: property OnClick; ! 362: property OnKeyPress; ! 363: property OnKeyBuffer : TKeyBufferEvent read FOnKeyBuffer write FOnKeyBuffer; ! 364: property OnKeyDown : TKeyDownEvent read FOnKeyDown write FOnKeyDown; ! 365: property Ctl3D; ! 366: property Align; ! 367: property TabStop; ! 368: property TabOrder; ! 369: property BorderStyle: TBorderStyle read FBorderStyle write FBorderStyle; ! 370: property AutoRepaint : Boolean read FAutoRepaint write FAutoRepaint; ! 371: property Font : TFont read FFont write SetFont; ! 372: property LocalEcho : Boolean read FLocalEcho write FLocalEcho; ! 373: property AutoLF : Boolean read GetAutoLF write SetAutoLF; ! 374: property AutoCR : Boolean read GetAutoCR write SetAutoCR; ! 375: property Xlat : Boolean read GetXlat write SetXlat; ! 376: property MonoChrome : Boolean read FMonoChrome write FMonoChrome; ! 377: property Log : Boolean read FLog write SetLog; ! 378: property Rows : Integer read GetRows write SetRows; ! 379: property Cols : Integer read GetCols write SetCols; ! 380: property LineHeight : Integer read FLineHeight write SetLineHeight; ! 381: property FKeys : Integer read FFKeys write FFKeys; ! 382: property SelectRect : TRect read FSelectRect write FSelectRect; ! 383: property BackRows : Integer read GetBackRows write SetBackRows; ! 384: property BackColor : TBackColors read GetBackColor write SetBackColor; ! 385: property Options : TScreenOptions read GetOptions write SetOptions; ! 386: end; ! 387: ! 388: { Same as TCustomEmulVT, but with published properties } ! 389: TEmulVT = class(TCustomEmulVT) ! 390: public ! 391: property Screen : TScreen read FScreen; ! 392: property SelectRect; ! 393: property Text; ! 394: published ! 395: property OnMouseMove; ! 396: property OnMouseDown; ! 397: property OnMouseUp; ! 398: property OnClick; ! 399: property OnKeyPress; ! 400: property OnKeyDown; ! 401: property OnKeyBuffer; ! 402: property Ctl3D; ! 403: property Align; ! 404: property BorderStyle; ! 405: property AutoRepaint; ! 406: property Font; ! 407: property LocalEcho; ! 408: property AutoLF; ! 409: property AutoCR; ! 410: property Xlat; ! 411: property MonoChrome; ! 412: property Log; ! 413: property Rows; ! 414: property Cols; ! 415: property BackRows; ! 416: property BackColor; ! 417: property Options; ! 418: property LineHeight; ! 419: property CharWidth; ! 420: property TabStop; ! 421: property TabOrder; ! 422: property FKeys; ! 423: end; ! 424: ! 425: const ! 426: F_BLACK = $00; ! 427: F_BLUE = $01; ! 428: F_GREEN = $02; ! 429: F_CYAN = $03; ! 430: F_RED = $04; ! 431: F_MAGENTA = $05; ! 432: F_BROWN = $06; ! 433: F_WHITE = $07; ! 434: ! 435: B_BLACK = $00; ! 436: B_BLUE = $01; ! 437: B_GREEN = $02; ! 438: B_CYAN = $03; ! 439: B_RED = $04; ! 440: B_MAGENTA = $05; ! 441: B_BROWN = $06; ! 442: B_WHITE = $07; ! 443: ! 444: F_INTENSE = $08; ! 445: B_BLINK = $80; ! 446: ! 447: { Function keys (SCO Console) } ! 448: FKeys1 : TFuncKeysTable = ( ! 449: (ScanCode: #$48; Shift: []; Ext: TRUE ; Value: #$1B + '[A'), { UP } ! 450: (ScanCode: #$50; Shift: []; Ext: TRUE ; Value: #$1B + '[B'), { DOWN } ! 451: (ScanCode: #$4D; Shift: []; Ext: TRUE ; Value: #$1B + '[C'), { RIGHT } ! 452: (ScanCode: #$4B; Shift: []; Ext: TRUE ; Value: #$1B + '[D'), { LEFT } ! 453: (ScanCode: #$49; Shift: []; Ext: TRUE ; Value: #$1B + '[I'), { PREV } ! 454: (ScanCode: #$51; Shift: []; Ext: TRUE ; Value: #$1B + '[G'), { NEXT } ! 455: (ScanCode: #$47; Shift: []; Ext: TRUE ; Value: #$1B + '[H'), { HOME } ! 456: (ScanCode: #$4F; Shift: []; Ext: TRUE ; Value: #$1B + '[F'), { END } ! 457: (ScanCode: #$52; Shift: []; Ext: TRUE ; Value: #$1B + '[L'), { INS } ! 458: (ScanCode: #$0F; Shift: []; Ext: FALSE; Value: #$1B + '[Z'), { RTAB } ! 459: (ScanCode: #$53; Shift: []; Ext: TRUE ; Value: #$7F ), { DEL } ! 460: (ScanCode: #$3B; Shift: []; Ext: FALSE; Value: #$1B + '[M'), { F1 } ! 461: (ScanCode: #$3C; Shift: []; Ext: FALSE; Value: #$1B + '[N'), ! 462: (ScanCode: #$3D; Shift: []; Ext: FALSE; Value: #$1B + '[O'), ! 463: (ScanCode: #$3E; Shift: []; Ext: FALSE; Value: #$1B + '[P'), ! 464: (ScanCode: #$3F; Shift: []; Ext: FALSE; Value: #$1B + '[Q'), ! 465: (ScanCode: #$40; Shift: []; Ext: FALSE; Value: #$1B + '[R'), ! 466: (ScanCode: #$41; Shift: []; Ext: FALSE; Value: #$1B + '[S'), ! 467: (ScanCode: #$42; Shift: []; Ext: FALSE; Value: #$1B + '[T'), ! 468: (ScanCode: #$43; Shift: []; Ext: FALSE; Value: #$1B + '[U'), ! 469: (ScanCode: #$44; Shift: []; Ext: FALSE; Value: #$1B + '[V'), { F10 } ! 470: (ScanCode: #$85; Shift: []; Ext: FALSE; Value: #$1B + '[W'), { F11 } ! 471: (ScanCode: #$86; Shift: []; Ext: FALSE; Value: #$1B + '[X'), { F12 } ! 472: (ScanCode: #$3B; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[V'),{ SF1 should be 'Y' } ! 473: (ScanCode: #$3C; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[Z'), ! 474: (ScanCode: #$3D; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[a'), ! 475: (ScanCode: #$3E; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[b'), ! 476: (ScanCode: #$3F; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[c'), ! 477: (ScanCode: #$40; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[d'), ! 478: (ScanCode: #$41; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[e'), ! 479: (ScanCode: #$42; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[f'), ! 480: (ScanCode: #$43; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[g'), ! 481: (ScanCode: #$44; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[h'), ! 482: (ScanCode: #$85; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[i'), ! 483: (ScanCode: #$86; Shift: [ssShift]; Ext: FALSE; Value: #$1B + '[j'),{ SF10 } ! 484: (ScanCode: #$3B; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[k'), { CF1 } ! 485: (ScanCode: #$3C; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[l'), ! 486: (ScanCode: #$3D; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[m'), ! 487: (ScanCode: #$3E; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[n'), ! 488: (ScanCode: #$3F; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[o'), ! 489: (ScanCode: #$40; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[p'), ! 490: (ScanCode: #$41; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[q'), ! 491: (ScanCode: #$42; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[r'), ! 492: (ScanCode: #$43; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[s'), ! 493: (ScanCode: #$44; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[t'), ! 494: (ScanCode: #$85; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[u'), ! 495: (ScanCode: #$86; Shift: [ssCtrl]; Ext: FALSE; Value: #$1B + '[v'), { CF12 } ! 496: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 497: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 498: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 499: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 500: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 501: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 502: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 503: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 504: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 505: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 506: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 507: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 508: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 509: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 510: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 511: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 512: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ) ! 513: ); ! 514: ! 515: { Alternate function keys (ordinary VT keys) } ! 516: FKeys2 : TFuncKeysTable = ( ! 517: (ScanCode: #$48; Shift: []; Ext: TRUE ; Value: #$1B + '[A'), { UP } ! 518: (ScanCode: #$50; Shift: []; Ext: TRUE ; Value: #$1B + '[B'), { DOWN } ! 519: (ScanCode: #$4D; Shift: []; Ext: TRUE ; Value: #$1B + '[C'), { RIGHT } ! 520: (ScanCode: #$4B; Shift: []; Ext: TRUE ; Value: #$1B + '[D'), { LEFT } ! 521: (ScanCode: #$49; Shift: []; Ext: TRUE ; Value: #$1B + '[5~'), { PREV } ! 522: (ScanCode: #$51; Shift: []; Ext: TRUE ; Value: #$1B + '[6~'), { NEXT } ! 523: (ScanCode: #$52; Shift: []; Ext: TRUE ; Value: #$1B + '[2~'), { INSERT } ! 524: (ScanCode: #$53; Shift: []; Ext: TRUE ; Value: #$7F ), { DELETE } ! 525: (ScanCode: #$3B; Shift: []; Ext: FALSE; Value: #$1B + 'OP'), { F1->PF1 } ! 526: (ScanCode: #$3C; Shift: []; Ext: FALSE; Value: #$1B + 'OQ'), { F2->PF2 } ! 527: (ScanCode: #$3D; Shift: []; Ext: FALSE; Value: #$1B + 'OR'), { F3->PF3 } ! 528: (ScanCode: #$3E; Shift: []; Ext: FALSE; Value: #$1B + 'OS'), { F4->PF4 } ! 529: (ScanCode: #$57; Shift: []; Ext: FALSE; Value: #$1B + '[28~'), { F11->Aide } ! 530: (ScanCode: #$58; Shift: []; Ext: FALSE; Value: #$1B + '[29~'), { F12->Ex�cuter } ! 531: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 532: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 533: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 534: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 535: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 536: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 537: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 538: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 539: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 540: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 541: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 542: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 543: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 544: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 545: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 546: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 547: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 548: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 549: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 550: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 551: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 552: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 553: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 554: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 555: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 556: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 557: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 558: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 559: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 560: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 561: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 562: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 563: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 564: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 565: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 566: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 567: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 568: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 569: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 570: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 571: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 572: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 573: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 574: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 575: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 576: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 577: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 578: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 579: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 580: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ) ! 581: ); ! 582: ! 583: { A-Series Telnet function keys (ordinary VT100 keys + specials) } ! 584: FKeys3 : TFuncKeysTable = ( ! 585: (ScanCode: #$48; Shift: []; Ext: TRUE ; Value: #$1B + '[A'), { UP } ! 586: (ScanCode: #$50; Shift: []; Ext: TRUE ; Value: #$1B + '[B'), { DOWN } ! 587: (ScanCode: #$4D; Shift: []; Ext: TRUE ; Value: #$1B + '[C'), { RIGHT } ! 588: (ScanCode: #$4B; Shift: []; Ext: TRUE ; Value: #$1B + '[D'), { LEFT } ! 589: (ScanCode: #$49; Shift: []; Ext: TRUE ; Value: #$1B + '-'), { PREV } ! 590: (ScanCode: #$51; Shift: []; Ext: TRUE ; Value: #$1B + '+'), { NEXT } ! 591: (ScanCode: #$47; Shift: []; Ext: TRUE ; Value: #$1B + 'H'), { HOME } ! 592: (ScanCode: #$47; Shift: [ssCtrl]; Ext: TRUE ; Value: #$1B + 'C'),{ HOME } ! 593: (ScanCode: #$4F; Shift: []; Ext: TRUE ; Value: #$1B + 'R'), { END } ! 594: (ScanCode: #$52; Shift: []; Ext: TRUE ; Value: #$1B + 'I'), { INSERT } ! 595: (ScanCode: #$53; Shift: []; Ext: TRUE ; Value: #$7F ), { DELETE } ! 596: (ScanCode: #$3B; Shift: []; Ext: FALSE; Value: #$1B + 'OP'), { F1->PF1 } ! 597: (ScanCode: #$3C; Shift: []; Ext: FALSE; Value: #$1B + 'OQ'), { F2->PF2 } ! 598: (ScanCode: #$3D; Shift: []; Ext: FALSE; Value: #$1B + 'OR'), { F3->PF3 } ! 599: (ScanCode: #$3E; Shift: []; Ext: FALSE; Value: #$1B + 'OS'), { F4->PF4 } ! 600: (ScanCode: #$43; Shift: []; Ext: FALSE; Value: #$1B + 'OP'), { F9 } ! 601: (ScanCode: #$44; Shift: []; Ext: FALSE; Value: ''), { F10 } ! 602: (ScanCode: #$57; Shift: []; Ext: FALSE; Value: #$1B + 'OQ'), { F11 } ! 603: (ScanCode: #$58; Shift: []; Ext: FALSE; Value: #$1B + 'OS'), { F12 } ! 604: (ScanCode: #$0F; Shift: []; Ext: FALSE; Value: #$1B + 'Z'), { RTAB } ! 605: (ScanCode: #$40; Shift: []; Ext: FALSE; Value: #$1B + 'K'), { F6 } ! 606: (ScanCode: #$53; Shift: [ssCtrl]; Ext: TRUE ; Value: #$1B + 'D'), { CDEL } ! 607: (ScanCode: #$52; Shift: [ssCtrl]; Ext: TRUE ; Value: #$1B + 'L'), { CINS } ! 608: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 609: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 610: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 611: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 612: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 613: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 614: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 615: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 616: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 617: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 618: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 619: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 620: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 621: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 622: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 623: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 624: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 625: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 626: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 627: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 628: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 629: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 630: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 631: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 632: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 633: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 634: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 635: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 636: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 637: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 638: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 639: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 640: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 641: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 642: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 643: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 644: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 645: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 646: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 647: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ), ! 648: (ScanCode: #$00; Shift: []; Ext: FALSE; Value: '' ) ! 649: ); ! 650: ! 651: { Ethernet to screen } ! 652: ibm_iso8859_1_G0 : TXlatTable = ( ! 653: #$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07, { 00 - 07 } ! 654: #$08, #$09, #$0A, #$0B, #$0C, #$0D, #$0E, #$0F, { 08 - 0F } ! 655: #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17, { 10 - 17 } ! 656: #$18, #$19, #$1A, #$1B, #$1C, #$1D, #$1E, #$1F, { 18 - 1F } ! 657: #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27, { 20 - 27 } ! 658: #$28, #$29, #$2A, #$2B, #$2C, #$2D, #$2E, #$2F, { 28 - 2F } ! 659: #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37, { 30 - 37 } ! 660: #$38, #$39, #$3A, #$3B, #$3C, #$3D, #$3E, #$3F, { 38 - 3F } ! 661: #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47, { 40 - 47 } ! 662: #$48, #$49, #$4A, #$4B, #$4C, #$4D, #$4E, #$4F, { 48 - 4F } ! 663: #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57, { 50 - 57 } ! 664: #$58, #$59, #$5A, #$5B, #$5C, #$5D, #$5E, #$5F, { 58 - 5F } ! 665: #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67, { 60 - 67 } ! 666: #$68, #$69, #$6A, #$6B, #$6C, #$6D, #$6E, #$6F, { 68 - 6F } ! 667: #$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77, { 70 - 77 } ! 668: #$78, #$79, #$7A, #$7B, #$7C, #$7D, #$7E, #$7F, { 78 - 7F } ! 669: #$20, #$20, #$20, #$20, #$20, #$20, #$20, #$20, { 80 - 87 } ! 670: #$20, #$20, #$20, #$20, #$20, #$20, #$20, #$20, { 88 - 8F } ! 671: #$20, #$20, #$20, #$20, #$20, #$20, #$20, #$20, { 90 - 97 } ! 672: #$20, #$20, #$20, #$20, #$20, #$20, #$20, #$20, { 98 - 9F } ! 673: #$B1, #$AD, #$9B, #$9C, #$0F, #$9D, #$B3, #$15, { A0 - A7 } ! 674: #$20, #$43, #$A6, #$AE, #$AA, #$C4, #$52, #$C4, { A8 - AF } ! 675: #$F8, #$F1, #$FD, #$20, #$27, #$E6, #$14, #$FA, { B0 - B7 } ! 676: #$2C, #$20, #$A7, #$AF, #$AC, #$AB, #$20, #$A8, { B8 - BF } ! 677: #$41, #$41, #$41, #$41, #$8E, #$8F, #$92, #$80, { C0 - C7 } ! 678: #$45, #$45, #$45, #$45, #$45, #$49, #$49, #$49, { C8 - CF } ! 679: #$44, #$A5, #$4F, #$4F, #$4F, #$4F, #$4F, #$78, { D0 - D7 } ! 680: #$ED, #$55, #$55, #$55, #$55, #$59, #$70, #$E1, { D8 - DF } ! 681: #$85, #$A0, #$83, #$61, #$84, #$86, #$91, #$87, { E0 - E7 } ! 682: #$8A, #$82, #$88, #$89, #$8D, #$A1, #$8C, #$49, { E8 - EF } ! 683: #$64, #$A4, #$95, #$A2, #$93, #$6F, #$94, #$F6, { F0 - F7 } ! 684: #$ED, #$97, #$A3, #$96, #$9A, #$79, #$70, #$98); { F8 - FF } ! 685: ! 686: { Ethernet to screen } ! 687: ibm_iso8859_1_G1 : TXlatTable = ( ! 688: #$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07, { 00 - 07 } ! 689: #$08, #$09, #$0A, #$0B, #$0C, #$0D, #$0E, #$0F, { 08 - 0F } ! 690: #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17, { 10 - 17 } ! 691: #$18, #$19, #$1A, #$1B, #$1C, #$1D, #$1E, #$1F, { 18 - 1F } ! 692: #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27, { 20 - 27 } ! 693: #$28, #$29, #$2A, #$2B, #$2C, #$2D, #$2E, #$2F, { 28 - 2F } ! 694: #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37, { 30 - 37 } ! 695: #$38, #$39, #$3A, #$3B, #$3C, #$3D, #$3E, #$3F, { 38 - 3F } ! 696: #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47, { 40 - 47 } ! 697: #$48, #$49, #$4A, #$4B, #$4C, #$4D, #$4E, #$4F, { 48 - 4F } ! 698: #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57, { 50 - 57 } ! 699: #$58, #$59, #$5A, #$5B, #$5C, #$5D, #$5E, #$5F, { 58 - 5F } ! 700: #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67, { 60 - 67 } ! 701: #$68, #$69, #$D9, #$BF, #$DA, #$C0, #$C5, #$6F, { 68 - 6F } ! 702: #$70, #$C4, #$72, #$73, #$C3, #$B4, #$C1, #$C2, { 70 - 77 } ! 703: #$B3, #$79, #$7A, #$7B, #$7C, #$7D, #$7E, #$7F, { 78 - 7F } ! 704: #$20, #$20, #$20, #$20, #$20, #$20, #$20, #$20, { 80 - 87 } ! 705: #$20, #$20, #$20, #$20, #$20, #$20, #$20, #$20, { 88 - 8F } ! 706: #$20, #$20, #$20, #$20, #$20, #$20, #$20, #$20, { 90 - 97 } ! 707: #$20, #$20, #$20, #$20, #$20, #$20, #$20, #$20, { 98 - 9F } ! 708: #$B1, #$AD, #$9B, #$9C, #$0F, #$9D, #$B3, #$15, { A0 - A7 } ! 709: #$20, #$43, #$A6, #$AE, #$AA, #$C4, #$52, #$C4, { A8 - AF } ! 710: #$F8, #$F1, #$FD, #$20, #$27, #$E6, #$14, #$FA, { B0 - B7 } ! 711: #$2C, #$20, #$A7, #$AF, #$AC, #$AB, #$20, #$A8, { B8 - BF } ! 712: #$41, #$41, #$41, #$41, #$8E, #$8F, #$92, #$80, { C0 - C7 } ! 713: #$45, #$45, #$45, #$45, #$45, #$49, #$49, #$49, { C8 - CF } ! 714: #$44, #$A5, #$4F, #$4F, #$4F, #$4F, #$4F, #$78, { D0 - D7 } ! 715: #$ED, #$55, #$55, #$55, #$55, #$59, #$70, #$E1, { D8 - DF } ! 716: #$85, #$A0, #$83, #$61, #$84, #$86, #$91, #$87, { E0 - E7 } ! 717: #$8A, #$82, #$88, #$89, #$8D, #$A1, #$8C, #$49, { E8 - EF } ! 718: #$64, #$A4, #$95, #$A2, #$93, #$6F, #$94, #$F6, { F0 - F7 } ! 719: #$ED, #$97, #$A3, #$96, #$9A, #$79, #$70, #$98); { F8 - FF } ! 720: ! 721: { Keyboard to Ethernet } ! 722: Output : TXlatTable = ( ! 723: #$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07, { 00 - 07 } ! 724: #$08, #$09, #$0A, #$0B, #$0C, #$0D, #$0E, #$0F, { 08 - 0F } ! 725: #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17, { 10 - 17 } ! 726: #$18, #$19, #$1A, #$1B, #$1C, #$1D, #$1E, #$1F, { 18 - 1F } ! 727: #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27, { 20 - 27 } ! 728: #$28, #$29, #$2A, #$2B, #$2C, #$2D, #$2E, #$2F, { 28 - 2F } ! 729: #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37, { 30 - 37 } ! 730: #$38, #$39, #$3A, #$3B, #$3C, #$3D, #$3E, #$3F, { 38 - 3F } ! 731: #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47, { 40 - 47 } ! 732: #$48, #$49, #$4A, #$4B, #$4C, #$4D, #$4E, #$4F, { 48 - 4F } ! 733: #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57, { 50 - 57 } ! 734: #$58, #$59, #$5A, #$5B, #$5C, #$5D, #$5E, #$5F, { 58 - 5F } ! 735: #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67, { 60 - 67 } ! 736: #$68, #$69, #$6A, #$6B, #$6C, #$6D, #$6E, #$6F, { 68 - 6F } ! 737: #$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77, { 70 - 77 } ! 738: #$78, #$79, #$7A, #$7B, #$7C, #$7D, #$7E, #$7F, { 78 - 7F } ! 739: #$C7, #$FC, #$E9, #$E2, #$E4, #$E0, #$E5, #$E7, { 80 - 87 } ! 740: #$EA, #$EB, #$E8, #$EF, #$EE, #$EC, #$C4, #$C5, { 88 - 8F } ! 741: #$C9, #$E6, #$C6, #$F4, #$F6, #$F2, #$FB, #$F9, { 90 - 97 } ! 742: #$FF, #$F6, #$FC, #$A2, #$A3, #$A5, #$DE, #$20, { 98 - 9F } ! 743: #$E1, #$ED, #$F3, #$FA, #$F1, #$D1, #$AA, #$BA, { A0 - A7 } ! 744: #$BF, #$20, #$AC, #$BD, #$BC, #$A1, #$AB, #$BB, { A8 - AF } ! 745: #$A0, #$A0, #$A0, #$A6, #$A6, #$A6, #$A6, #$AD, { B0 - B7 } ! 746: #$2B, #$A6, #$A6, #$2B, #$2B, #$2B, #$2B, #$2B, { B8 - BF } ! 747: #$2B, #$AD, #$AD, #$AD, #$A6, #$AD, #$2B, #$A6, { C0 - C7 } ! 748: #$2B, #$2B, #$AD, #$AD, #$A6, #$AD, #$2B, #$AD, { C8 - CF } ! 749: #$AD, #$AD, #$AD, #$2B, #$2B, #$2B, #$2B, #$2B, { D0 - D7 } ! 750: #$2B, #$2B, #$2B, #$A0, #$A0, #$A0, #$A0, #$A0, { D8 - DF } ! 751: #$20, #$20, #$20, #$AD, #$20, #$20, #$B5, #$20, { E0 - E7 } ! 752: #$20, #$20, #$20, #$20, #$20, #$F8, #$20, #$20, { E8 - EF } ! 753: #$A0, #$B1, #$20, #$20, #$20, #$20, #$F7, #$20, { F0 - F7 } ! 754: #$B0, #$B0, #$B0, #$20, #$20, #$B2, #$A0, #$20); { F8 - FF } ! 755: ! 756: procedure Register; ! 757: procedure FKeysToFile(var FKeys : TFuncKeysTable; FName : String); ! 758: procedure FileToFKeys(var FKeys : TFuncKeysTable; FName : String); ! 759: function AddFKey(var FKeys : TFuncKeysTable; ! 760: ScanCode : Char; ! 761: Shift : TShiftState; ! 762: Ext : Boolean; ! 763: Value : TFuncKeyValue) : Boolean; ! 764: ! 765: ! 766: ! 767: implementation ! 768: {$DEFINE Debug} { Add or remove minus sign before dollar sign to } ! 769: { generate code for debug message output } ! 770: var ! 771: FCharPos : array [0..MAX_COL + 1] of integer; ! 772: FLinePos : array [0..MAX_ROW + 1] of integer; ! 773: ! 774: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 775: procedure Register; ! 776: begin ! 777: RegisterComponents('FPiette', [TEmulVT]); ! 778: end; ! 779: ! 780: ! 781: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 782: function ShiftStateToString(var State : TShiftState) : String; ! 783: begin ! 784: Result := ''; ! 785: if ssShift in State then ! 786: Result := Result + 'ssShift '; ! 787: if ssAlt in State then ! 788: Result := Result + 'ssAlt '; ! 789: if ssCtrl in State then ! 790: Result := Result + 'ssCtrl '; ! 791: if ssLeft in State then ! 792: Result := Result + 'ssLeft '; ! 793: if ssRight in State then ! 794: Result := Result + 'ssRight '; ! 795: if ssMiddle in State then ! 796: Result := Result + 'ssMiddle '; ! 797: if ssDouble in State then ! 798: Result := Result + 'ssDouble '; ! 799: if Result = '' then ! 800: Result := 'ssNormal'; ! 801: end; ! 802: ! 803: ! 804: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 805: function StringToShiftState(var S : String) : TShiftState; ! 806: begin ! 807: Result := []; ! 808: if Pos('ssShift', S) <> 0 then ! 809: Result := Result + [ssShift]; ! 810: if Pos('ssAlt', S) <> 0 then ! 811: Result := Result + [ssAlt]; ! 812: if Pos('ssCtrl', S) <> 0 then ! 813: Result := Result + [ssCtrl]; ! 814: if Pos('ssLeft', S) <> 0 then ! 815: Result := Result + [ssLeft]; ! 816: if Pos('ssRight', S) <> 0 then ! 817: Result := Result + [ssRight]; ! 818: if Pos('ssMiddle', S) <> 0 then ! 819: Result := Result + [ssMiddle]; ! 820: if Pos('ssDouble', S) <> 0 then ! 821: Result := Result + [ssDouble]; ! 822: end; ! 823: ! 824: ! 825: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 826: function xdigit(Ch : char) : integer; ! 827: begin ! 828: if ch in ['0'..'9'] then ! 829: Result := Ord(ch) - ord('0') ! 830: else if ch in ['A'..'Z'] then ! 831: Result := Ord(ch) - Ord('A') + 10 ! 832: else if ch in ['a'..'z'] then ! 833: Result := Ord(ch) - Ord('a') + 10 ! 834: else ! 835: Result := 0; ! 836: end; ! 837: ! 838: ! 839: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 840: function xdigit2(S : PChar) : integer; ! 841: begin ! 842: Result := 16 * xdigit(S[0]) + xdigit(S[1]); ! 843: end; ! 844: ! 845: ! 846: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 847: function FuncKeyValueToString(var S : TFuncKeyValue) : String; ! 848: var ! 849: I : Integer; ! 850: begin ! 851: Result := ''; ! 852: for I := 1 to Length(S) do begin ! 853: if (Ord(S[I]) < 32) or (Ord(S[I]) >= 127) or ! 854: (S[I] = '''') or (S[I] = '\') then ! 855: Result := Result + '\x' + IntToHex(Ord(S[I]), 2) ! 856: else ! 857: Result := Result + S[I]; ! 858: end; ! 859: end; ! 860: ! 861: ! 862: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 863: function StringToFuncKeyValue(var S : String) : TFuncKeyValue; ! 864: var ! 865: I : Integer; ! 866: begin ! 867: Result := ''; ! 868: I := 1; ! 869: while I <= Length(S) do begin ! 870: if (S[I] = '\') and ! 871: ((I + 3) <= Length(S)) and ! 872: (S[I + 1] = 'x') then begin ! 873: Result := Result + chr(xdigit2(@S[I + 2])); ! 874: I := I + 3; ! 875: end ! 876: else ! 877: Result := Result + S[I]; ! 878: Inc(I); ! 879: end; ! 880: end; ! 881: ! 882: ! 883: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 884: function AddFKey(var FKeys : TFuncKeysTable; ! 885: ScanCode : Char; ! 886: Shift : TShiftState; ! 887: Ext : Boolean; ! 888: Value : TFuncKeyValue) : Boolean; ! 889: var ! 890: I : Integer; ! 891: begin ! 892: { Search for existing key definition to replace it } ! 893: for I := Low(FKeys) to High(FKeys) do begin ! 894: if (FKeys[I].ScanCode = ScanCode) and ! 895: (FKeys[I].Shift = Shift) and ! 896: (FKeys[I].Ext = Ext) then begin ! 897: FKeys[I].Value := Value; ! 898: Result := TRUE; { Success} ! 899: Exit; ! 900: end; ! 901: end; ! 902: ! 903: { Key not existing, add in an empty space } ! 904: for I := Low(FKeys) to High(FKeys) do begin ! 905: if FKeys[I].ScanCode = #0 then begin ! 906: FKeys[I].ScanCode := ScanCode; ! 907: FKeys[I].Shift := Shift; ! 908: FKeys[I].Ext := Ext; ! 909: FKeys[I].Value := Value; ! 910: Result := TRUE; { Success} ! 911: Exit; ! 912: end; ! 913: end; ! 914: ! 915: { Failure, no more space available } ! 916: Result := FALSE; ! 917: end; ! 918: ! 919: ! 920: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 921: procedure FKeysToFile(var FKeys : TFuncKeysTable; FName : String); ! 922: var ! 923: I : Integer; ! 924: F : TextFile; ! 925: begin ! 926: AssignFile(F, FName); ! 927: Rewrite(F); ! 928: for I := Low(FKeys) to High(FKeys) do begin ! 929: with FKeys[I] do begin ! 930: if ScanCode <> chr(0) then ! 931: WriteLn(F, IntToHex(Ord(ScanCode), 2), ', ', ! 932: ShiftStateToString(Shift), ', ', ! 933: Ext, ', ''', ! 934: FuncKeyValueToString(Value), ''''); ! 935: end; ! 936: end; ! 937: CloseFile(F); ! 938: end; ! 939: ! 940: ! 941: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 942: function GetToken(var S : String; var I : Integer; Delim : Char) : String; ! 943: begin ! 944: Result := ''; ! 945: while (I <= Length(S)) and (S[I] = ' ') do ! 946: Inc(I); ! 947: while (I <= Length(S)) and (S[I] <> Delim) do begin ! 948: Result := Result + S[I]; ! 949: Inc(I); ! 950: end; ! 951: end; ! 952: ! 953: ! 954: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 955: procedure FileToFKeys(var FKeys : TFuncKeysTable; FName : String); ! 956: var ! 957: I, J : Integer; ! 958: F : TextFile; ! 959: S, T : String; ! 960: sc : Integer; ! 961: begin ! 962: AssignFile(F, FName); ! 963: {$I-} ! 964: Reset(F); ! 965: if IOResult <> 0 then begin ! 966: { File do not exist, create default one } ! 967: FKeysToFile(FKeys, FName); ! 968: Exit; ! 969: end; ! 970: ! 971: for I := Low(FKeys) to High(FKeys) do begin ! 972: with FKeys[I] do begin ! 973: ScanCode := chr(0); ! 974: Shift := []; ! 975: Ext := FALSE; ! 976: Value := ''; ! 977: if not Eof(F) then begin ! 978: { 71, ssNormal, TRUE, '\x1B[H' } ! 979: ReadLn(F, S); ! 980: J := 1; ! 981: T := GetToken(S, J, ','); ! 982: if (Length(T) > 0) and (T[1] <> ';') then begin ! 983: sc := xdigit2(@T[1]); ! 984: if sc <> 0 then begin ! 985: ScanCode := chr(sc); ! 986: Inc(J); ! 987: T := GetToken(S, J, ','); ! 988: Shift := StringToShiftState(T); ! 989: Inc(J); ! 990: T := GetToken(S, J, ','); ! 991: Ext := UpperCase(T) = 'TRUE'; ! 992: Inc(J); ! 993: T := GetToken(S, J, ''''); ! 994: Inc(J); ! 995: T := GetToken(S, J, ''''); ! 996: Value := StringToFuncKeyValue(T); ! 997: end; ! 998: end; ! 999: end; ! 1000: end; ! 1001: end; ! 1002: CloseFile(F); ! 1003: {$I+} ! 1004: end; ! 1005: ! 1006: ! 1007: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1008: procedure DebugString(Msg : String); ! 1009: const ! 1010: Cnt : Integer = 0; ! 1011: var ! 1012: Buf : String[20]; ! 1013: begin ! 1014: {$IFDEF Debug} ! 1015: Cnt := Cnt + 1; ! 1016: Buf := IntToHex(Cnt, 4) + ' ' + #0; ! 1017: OutputDebugString(@Buf[1]); ! 1018: ! 1019: {$IFNDEF WIN32} ! 1020: if Length(Msg) < High(Msg) then ! 1021: Msg[Length(Msg) + 1] := #0; ! 1022: {$ENDIF} ! 1023: ! 1024: OutputDebugString(@Msg[1]); ! 1025: {$ENDIF} ! 1026: end; ! 1027: ! 1028: ! 1029: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1030: {$IFNDEF WIN32} ! 1031: procedure SetLength(var S: string; NewLength: Integer); ! 1032: begin ! 1033: S[0] := chr(NewLength); ! 1034: end; ! 1035: {$ENDIF} ! 1036: ! 1037: ! 1038: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1039: constructor TLine.Create; ! 1040: begin ! 1041: inherited Create; ! 1042: FillChar(Txt, SizeOf(Txt), ' '); ! 1043: FillChar(Att, SizeOf(Att), Chr(F_WHITE)); ! 1044: end; ! 1045: ! 1046: ! 1047: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1048: procedure TLine.Clear(Attr : Byte); ! 1049: begin ! 1050: FillChar(Txt, SizeOF(Txt), ' '); ! 1051: FillChar(Att, SizeOf(Att), Attr); ! 1052: end; ! 1053: ! 1054: ! 1055: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1056: constructor TScreen.Create; ! 1057: begin ! 1058: inherited Create; ! 1059: FRowCount := 0; ! 1060: FBackRowCount := 0; ! 1061: FBackEndRow := 0; ! 1062: FBackColor := vtsWhite; ! 1063: FOptions := [vtoBackColor]; ! 1064: SetRowCount(25); ! 1065: FColCount := 80; ! 1066: FRowSaved := -1; ! 1067: FColSaved := -1; ! 1068: FScrollRowTop := 0; ! 1069: {FScrollRowBottom := FRowCount - 1; // WM + SE 09/08/00 } ! 1070: FAttribute := F_WHITE; ! 1071: InvClear; ! 1072: end; ! 1073: ! 1074: ! 1075: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1076: destructor TScreen.Destroy; ! 1077: var ! 1078: nRow : Integer; ! 1079: begin ! 1080: for nRow := 0 to FRowCount + FBackRowCount - 1 do ! 1081: FLines^[nRow].Free; ! 1082: FreeMem (FLines, (FRowCount + FBackRowCount) * SizeOf(TObject)); ! 1083: end; ! 1084: ! 1085: ! 1086: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1087: procedure TScreen.AdjustFLines(NewCount : Integer); ! 1088: var ! 1089: NewLines : PLineArray; ! 1090: CurrCount : Integer; ! 1091: nRow : Integer; ! 1092: begin ! 1093: CurrCount := FRowCount + FBackRowCount; ! 1094: if (NewCount <> CurrCount) and (NewCount > 0) then begin ! 1095: GetMem(NewLines, NewCount * SizeOf(TObject)); ! 1096: if NewCount > CurrCount then begin ! 1097: if CurrCount <> 0 then ! 1098: Move(FLines^, NewLines^, CurrCount * SizeOf(TObject)); ! 1099: for nRow := CurrCount to NewCount - 1 do ! 1100: NewLines^[nRow] := TLine.Create; ! 1101: if CurrCount <> 0 then ! 1102: FreeMem(FLines, CurrCount * SizeOf(TObject)); ! 1103: end ! 1104: else begin ! 1105: Move (FLines^, NewLines^, NewCount * SizeOf(TObject)); ! 1106: for nRow := NewCount to CurrCount - 1 do ! 1107: FLines^[nRow].Free; ! 1108: FreeMem(FLines, CurrCount * SizeOf(TObject)); ! 1109: end; ! 1110: FLines := NewLines; ! 1111: end; ! 1112: end; ! 1113: ! 1114: ! 1115: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1116: procedure TScreen.SetRowCount(NewCount : Integer); ! 1117: begin ! 1118: if NewCount <> FRowCount then begin ! 1119: AdjustFLines(NewCount + FBackRowCount); ! 1120: FRowCount := NewCount; ! 1121: FScrollRowBottom := FRowCount - 1; { WM + SE 09/08/00 } ! 1122: end; ! 1123: end; ! 1124: ! 1125: ! 1126: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1127: procedure TScreen.SetBackRowCount(NewCount : Integer); ! 1128: begin ! 1129: if NewCount <> FBackRowCount then begin ! 1130: AdjustFLines(FRowCount + NewCount); ! 1131: FBackRowCount := NewCount; ! 1132: end; ! 1133: end; ! 1134: ! 1135: ! 1136: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1137: procedure TScreen.CopyScreenToBack; ! 1138: { Copies the current host screen into the scrollback buffer. } ! 1139: var ! 1140: Temp : TLine; ! 1141: Row : Integer; ! 1142: Pass : Integer; ! 1143: nCol : Integer; ! 1144: begin ! 1145: if FBackRowCount >= FRowCount then begin ! 1146: Dec (FBackEndRow, FRowCount); ! 1147: if (0 - FBackEndRow) >= FBackRowCount then ! 1148: FBackEndRow := 1 - FBackRowCount; ! 1149: { We have to make FRowCount lines available at the head of the ! 1150: scrollback buffer. These will come from the end of the scrollback ! 1151: buffer. We'll make FRowCount passes through the scrollback buffer ! 1152: moving the available lines up to the top and the existing lines ! 1153: down a page at a time. ! 1154: Net result is that we only move each line once. } ! 1155: For Pass := 0 To FRowCount - 1 Do begin ! 1156: Row := FBackEndRow + Pass; ! 1157: Temp := Lines[Row]; ! 1158: Inc (Row, FRowCount); ! 1159: While Row < 0 Do begin ! 1160: Lines[Row - FRowCount] := Lines[Row]; ! 1161: Inc (Row, FRowCount); ! 1162: end; ! 1163: Lines[Row - FRowCount] := Temp; ! 1164: end; ! 1165: ! 1166: { Now, copy the host screen lines to the ons we made available. } ! 1167: For Row := 0 To FRowCount - 1 Do begin ! 1168: Move (Lines[Row].Txt, Lines[Row - FRowCount].Txt, FColCount); ! 1169: Move (Lines[Row].Att, Lines[Row - FRowCount].Att, FColCount); ! 1170: if vtoBackColor in FOptions then begin ! 1171: with Lines[Row - FRowCount] do begin ! 1172: for nCol := 0 to FColCount - 1 do begin ! 1173: Att[nCol] := Att[nCol] And $8F Or (Ord (FBackColor) shl 4); ! 1174: end; ! 1175: end; ! 1176: end; ! 1177: end; ! 1178: end; ! 1179: end; ! 1180: ! 1181: ! 1182: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1183: procedure TScreen.ScrollUp; ! 1184: var ! 1185: Temp : TLine; ! 1186: Row : Integer; ! 1187: nCol : Integer; ! 1188: begin ! 1189: if FBackRowCount > 0 then begin ! 1190: if (0 - FBackEndRow) < (FBackRowCount - 1) then ! 1191: Dec (FBackEndRow); ! 1192: Temp := Lines[FBackEndRow]; ! 1193: For Row := FBackEndRow + 1 To -1 Do begin ! 1194: Lines[Row - 1] := Lines[Row]; ! 1195: end; ! 1196: Lines[-1] := Lines[FScrollRowTop]; ! 1197: if vtoBackColor in FOptions then begin ! 1198: with Lines[-1] do begin ! 1199: for nCol := 0 to FColCount - 1 do begin ! 1200: Att[nCol] := Att[nCol] And $8F Or (Ord (FBackColor) shl 4); ! 1201: end; ! 1202: end; ! 1203: end; ! 1204: ! 1205: end ! 1206: else ! 1207: Temp := Lines[FScrollRowTop]; ! 1208: ! 1209: for Row := FScrollRowTop + 1 to FScrollRowBottom do ! 1210: Lines[Row - 1] := Lines[Row]; ! 1211: Lines[FScrollRowBottom] := Temp; ! 1212: Temp.Clear(F_WHITE {FAttribute}); ! 1213: FAllInvalid := TRUE; ! 1214: end; ! 1215: ! 1216: ! 1217: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1218: procedure TScreen.ScrollDown; ! 1219: var ! 1220: Temp : TLine; ! 1221: Row : Integer; ! 1222: begin ! 1223: Temp := Lines[FScrollRowBottom]; ! 1224: for Row := FScrollRowBottom DownTo FScrollRowTop + 1 do ! 1225: Lines[Row] := Lines[Row - 1]; ! 1226: Lines[FScrollRowTop] := Temp; ! 1227: Temp.Clear(F_WHITE {FAttribute}); ! 1228: FAllInvalid := TRUE; ! 1229: end; ! 1230: ! 1231: ! 1232: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1233: procedure TScreen.CursorDown; ! 1234: begin ! 1235: Inc(FRow); ! 1236: if FRow > FScrollRowBottom then begin ! 1237: FRow := FScrollRowBottom; ! 1238: ScrollUp; ! 1239: end; ! 1240: end; ! 1241: ! 1242: ! 1243: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1244: procedure TScreen.CursorUp; ! 1245: begin ! 1246: Dec(FRow); ! 1247: if FRow < 0 then begin ! 1248: Inc(FRow); ! 1249: ScrollDown; ! 1250: end; ! 1251: end; ! 1252: ! 1253: ! 1254: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1255: procedure TScreen.CursorRight; ! 1256: begin ! 1257: Inc(FCol); ! 1258: if FCol >= FColCount then begin ! 1259: FCol := 0; ! 1260: CursorDown; ! 1261: end; ! 1262: end; ! 1263: ! 1264: ! 1265: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1266: procedure TScreen.CursorLeft; ! 1267: begin ! 1268: Dec(FCol); ! 1269: if FCol < 0 then begin ! 1270: FCol := FColCount - 1; ! 1271: CursorUp; ! 1272: end; ! 1273: end; ! 1274: ! 1275: ! 1276: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1277: procedure TScreen.CarriageReturn; ! 1278: begin ! 1279: FCol := 0; ! 1280: end; ! 1281: ! 1282: ! 1283: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1284: function TScreen.GetEscapeParam(From : Integer; var Value : Integer) : Integer; ! 1285: begin ! 1286: while (From <= Length(FEscBuffer)) and (FEscBuffer[From] = ' ') do ! 1287: From := From + 1; ! 1288: ! 1289: Value := 0; ! 1290: while (From <= Length(FEscBuffer)) and (FEscBuffer[From] in ['0'..'9']) do begin ! 1291: Value := Value * 10 + Ord(FEscBuffer[From]) - Ord('0'); ! 1292: From := From + 1; ! 1293: end; ! 1294: ! 1295: Result := From; ! 1296: end; ! 1297: ! 1298: ! 1299: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1300: procedure TScreen.UnimplementedEscape(EscCmd : Char); ! 1301: {var ! 1302: Buf : String;} ! 1303: begin ! 1304: DebugString('Unimplemented Escape Sequence: ' + FEscBuffer + EscCmd + #13 + #10); ! 1305: { Buf := FEscBuffer + EscCmd + #0; ! 1306: MessageBox(0, @Buf[1], 'Unimplemented Escape Sequence', MB_OK); } ! 1307: end; ! 1308: ! 1309: ! 1310: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1311: procedure TScreen.InvalidEscape(EscCmd : Char); ! 1312: {var ! 1313: Buf : String;} ! 1314: begin ! 1315: DebugString('Invalid Escape Sequence: ' + FEscBuffer + EscCmd + #13 + #10); ! 1316: { Buf := FEscBuffer + EscCmd + #0; ! 1317: MessageBox(0, @Buf[1], 'Invalid Escape Sequence', MB_OK); } ! 1318: end; ! 1319: ! 1320: ! 1321: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1322: procedure TScreen.ProcessESC_D; { Index } ! 1323: begin ! 1324: UnimplementedEscape('D'); ! 1325: end; ! 1326: ! 1327: ! 1328: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1329: { Move cursor Up, scroll down if necessary } ! 1330: procedure TScreen.ProcessESC_M; { Reverse index } ! 1331: begin ! 1332: Dec(FRow); ! 1333: if FRow < FScrollRowTop then begin ! 1334: FRow := FScrollRowTop; ! 1335: ScrollDown; ! 1336: end; ! 1337: end; ! 1338: ! 1339: ! 1340: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1341: procedure TScreen.ProcessESC_E; { Next line } ! 1342: begin ! 1343: UnimplementedEscape('E'); ! 1344: end; ! 1345: ! 1346: ! 1347: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1348: procedure TScreen.ProcessCSI_u; { Restore Cursor } ! 1349: begin ! 1350: UnimplementedEscape('u'); ! 1351: end; ! 1352: ! 1353: ! 1354: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1355: { IBM character set operation (not part of the ANSI standard) } ! 1356: { <ESC>[0I => Set IBM character set } ! 1357: { <ESC>[1;nnnI => Literal mode for nnn next characters } ! 1358: { <ESC>[2;onoffI => Switch carbon mode on (1) or off (0) } ! 1359: { <ESC>[3;ch;cl;sh;slI => Receive carbon mode keyboard code } ! 1360: { <ESC>[4I => Select ANSI character set } ! 1361: procedure TScreen.ProcessCSI_I; ! 1362: var ! 1363: From, mode, nnn : Integer; ! 1364: ch, cl, sh, sl : Integer; ! 1365: begin ! 1366: From := GetEscapeParam(2, Mode); ! 1367: ! 1368: case Mode of ! 1369: 0: begin { Select IBM character set } ! 1370: FNoXlat := TRUE; ! 1371: end; ! 1372: 1: begin { Set literal mode for next N characters } ! 1373: if FEscBuffer[From] = ';' then ! 1374: GetEscapeParam(From + 1, FCntLiteral) ! 1375: else ! 1376: FCntLiteral := 1; ! 1377: end; ! 1378: 2: begin { Switch carbon mode on or off } ! 1379: if FEscBuffer[From] = ';' then ! 1380: GetEscapeParam(From + 1, nnn) ! 1381: else ! 1382: nnn := 0; ! 1383: FCarbonMode := (nnn <> 0); ! 1384: end; ! 1385: 3: begin { Receive carbon mode key code } ! 1386: ch := 0; cl := 0; sh := 0; sl := 0; ! 1387: if FEscBuffer[From] = ';' then begin ! 1388: From := GetEscapeParam(From + 1, cl); ! 1389: if FEscBuffer[From] = ';' then begin ! 1390: From := GetEscapeParam(From + 1, ch); ! 1391: if FEscBuffer[From] = ';' then begin ! 1392: From := GetEscapeParam(From + 1, sl); ! 1393: if FEscBuffer[From] = ';' then begin ! 1394: GetEscapeParam(From + 1, sh); ! 1395: end; ! 1396: end; ! 1397: end; ! 1398: end; ! 1399: DebugString('Special key ' + ! 1400: IntToHex(ch, 2) + IntToHex(cl, 2) + ' ' + ! 1401: IntToHex(sh, 2) + IntToHex(sl, 2)); ! 1402: end; ! 1403: 4: begin { Select ANSI character set } ! 1404: FNoXlat := FALSE; ! 1405: end; ! 1406: else ! 1407: UnimplementedEscape('I'); ! 1408: end; ! 1409: end; ! 1410: ! 1411: ! 1412: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1413: procedure TScreen.BackSpace; ! 1414: begin ! 1415: if FCol > 0 then ! 1416: Dec(FCol); ! 1417: end; ! 1418: ! 1419: ! 1420: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1421: procedure TScreen.ClearScreen; ! 1422: var ! 1423: Row : Integer; ! 1424: begin ! 1425: for Row := 0 to FRowCount - 1 do ! 1426: Lines[Row].Clear(FAttribute); ! 1427: FRow := 0; ! 1428: FCol := 0; ! 1429: FAllInvalid := TRUE; ! 1430: end; ! 1431: ! 1432: ! 1433: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1434: procedure TScreen.InvClear; ! 1435: begin ! 1436: with FInvRect do begin ! 1437: Top := 9999; ! 1438: Left := 9999; ! 1439: Right := -1; ! 1440: Bottom := -1; ! 1441: end; ! 1442: FAllInvalid := FALSE; ! 1443: end; ! 1444: ! 1445: ! 1446: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1447: procedure TScreen.InvRect(nRow, nCol : Integer); ! 1448: begin ! 1449: if not FAllInvalid then begin ! 1450: if FInvRect.Top > nRow then ! 1451: FInvRect.Top := nRow; ! 1452: if FInvRect.Bottom < nRow then ! 1453: FInvRect.Bottom := nRow; ! 1454: if FInvRect.Left > nCol then ! 1455: FInvRect.Left := nCol; ! 1456: if FInvRect.Right < nCol then ! 1457: FInvRect.Right := nCol; ! 1458: end; ! 1459: end; ! 1460: ! 1461: ! 1462: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1463: { The FLines array is inverted with the last host line at position 0 and ! 1464: the first host line as position FRowCount - 1. } ! 1465: procedure Tscreen.SetLines(I : Integer; Value : TLine); ! 1466: begin ! 1467: if I >= FRowCount then ! 1468: FLines^[0] := Value ! 1469: else ! 1470: FLines^[FRowCount - 1 - I] := Value; ! 1471: end; ! 1472: ! 1473: ! 1474: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1475: function TScreen.GetLines(I : Integer) : TLine; ! 1476: begin ! 1477: if I >= FRowCount then ! 1478: Result := FLines^[0] ! 1479: else ! 1480: Result := FLines^[FRowCount - 1 - I]; ! 1481: end; ! 1482: ! 1483: ! 1484: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1485: procedure TScreen.Eol; ! 1486: begin ! 1487: with Lines[FRow] do begin ! 1488: FillChar(Txt[FCol], FColCount - FCol, ' '); ! 1489: FillChar(Att[FCol], (FColCount - FCol) * SizeOf(Att[FCol]), FAttribute); ! 1490: end; ! 1491: InvRect(Frow, FCol); ! 1492: InvRect(Frow, FColCount); ! 1493: end; ! 1494: ! 1495: ! 1496: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1497: procedure TScreen.Eop; ! 1498: var ! 1499: Row : Integer; ! 1500: begin ! 1501: Eol; ! 1502: for Row := FRow + 1 to FRowCount - 1 do ! 1503: Lines[Row].Clear(FAttribute); ! 1504: if FRow = 0 then ! 1505: FAllInvalid := TRUE ! 1506: else begin ! 1507: InvRect(FRow, 0); ! 1508: InvRect(FRowCount, FColCount); ! 1509: end; ! 1510: end; ! 1511: ! 1512: ! 1513: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1514: procedure TScreen.ProcessCSI_J; { Clear the screen } ! 1515: var ! 1516: Mode : Integer; ! 1517: Row : Integer; ! 1518: begin ! 1519: GetEscapeParam(2, Mode); ! 1520: case Mode of ! 1521: 0: begin { Cursor to end of screen } ! 1522: FAttribute := F_WHITE; ! 1523: Eop; ! 1524: end; ! 1525: 1: begin { Start of screen to cursor } ! 1526: for Row := 0 to FRow do ! 1527: Lines[Row].Clear(FAttribute); ! 1528: InvRect(0, 0); ! 1529: InvRect(FRow, FColCount); ! 1530: end; ! 1531: 2: begin { Entire screen } ! 1532: if vtoCopyBackOnClear in FOptions then CopyScreenToBack; ! 1533: ClearScreen; ! 1534: end; ! 1535: else ! 1536: InvalidEscape('J'); ! 1537: end; ! 1538: end; ! 1539: ! 1540: ! 1541: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1542: procedure TScreen.ProcessCSI_K; { Erase to End of Line } ! 1543: begin ! 1544: Eol; ! 1545: end; ! 1546: ! 1547: ! 1548: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1549: procedure TScreen.ProcessCSI_L; { Insert Line } ! 1550: var ! 1551: nLine : Integer; ! 1552: nRow : Integer; ! 1553: Temp : TLine; ! 1554: begin ! 1555: FCol := 0; ! 1556: GetEscapeParam(2, nLine); ! 1557: if nLine = 0 then ! 1558: nLine := 1; ! 1559: ! 1560: if (FRow + nLine) > FScrollRowBottom then begin ! 1561: for nRow := FRow to FScrollRowBottom do ! 1562: Lines[nRow].Clear(FAttribute); ! 1563: Exit; ! 1564: end; ! 1565: ! 1566: for nRow := FScrollRowBottom downto FRow + nLine do begin ! 1567: Temp := Lines[nRow]; ! 1568: Lines[nRow] := Lines[nRow - nLine]; ! 1569: Lines[nRow - nLine] := Temp; ! 1570: end; ! 1571: ! 1572: for nRow := FRow to FRow + nLine - 1 do ! 1573: Lines[nRow].Clear(FAttribute); ! 1574: ! 1575: FAllInvalid := TRUE; ! 1576: end; ! 1577: ! 1578: ! 1579: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1580: procedure TScreen.ProcessCSI_M; { Delete Line } ! 1581: var ! 1582: nLine : Integer; ! 1583: nRow : Integer; ! 1584: Temp : TLine; ! 1585: begin ! 1586: FAllInvalid := TRUE; ! 1587: FCol := 0; ! 1588: GetEscapeParam(2, nLine); ! 1589: if nLine = 0 then ! 1590: nLine := 1; ! 1591: ! 1592: if (FRow + nLine) > FScrollRowBottom then begin ! 1593: for nRow := FRow to FScrollRowBottom do ! 1594: Lines[nRow].Clear(FAttribute); ! 1595: Exit; ! 1596: end; ! 1597: ! 1598: for nRow := FRow to FRow + nLine - 1 do ! 1599: Lines[nRow].Clear(F_WHITE {FAttribute}); { 12/11/99 } ! 1600: for nRow := FRow to FScrollRowBottom - nLine do begin ! 1601: Temp := Lines[nRow]; ! 1602: Lines[nRow] := Lines[nRow + nLine]; ! 1603: Lines[nRow + nLine] := Temp; ! 1604: end; ! 1605: end; ! 1606: ! 1607: ! 1608: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1609: procedure TScreen.ProcessCSI_m_lc; { Select Attributes } ! 1610: var ! 1611: From, n : Integer; ! 1612: begin ! 1613: if FEscBuffer[1] <> '[' then ! 1614: Exit; ! 1615: ! 1616: if Length(FEscBuffer) < 2 then begin ! 1617: FAttribute := F_WHITE; ! 1618: FReverseVideo := FALSE; ! 1619: Exit; ! 1620: end; ! 1621: ! 1622: From := 2; ! 1623: while From <= Length(FEscBuffer) do begin ! 1624: if FEscBuffer[From] in [' ', '[', ';'] then ! 1625: Inc(From) ! 1626: else begin ! 1627: From := GetEscapeParam(From, n); ! 1628: case n of ! 1629: 0: begin { All attributes off } ! 1630: FAttribute := F_WHITE; ! 1631: FReverseVideo := FALSE; ! 1632: FUnderLine := FALSE; ! 1633: end; ! 1634: 1: begin { High intensity } ! 1635: FAttribute := FAttribute or F_INTENSE; ! 1636: end; ! 1637: 4: begin { Underline } ! 1638: FUnderLine := TRUE; ! 1639: end; ! 1640: 5: begin { Blinking } ! 1641: FAttribute := FAttribute or B_BLINK; ! 1642: end; ! 1643: 7: begin { Reverse video } ! 1644: FReverseVideo := TRUE; ! 1645: end; ! 1646: 8: begin { Secret } ! 1647: FAttribute := 0; ! 1648: end; ! 1649: 10: begin { Don't force high bit } ! 1650: FForceHighBit := FALSE; ! 1651: end; ! 1652: 12: begin { Force high bit on } ! 1653: FForceHighBit := TRUE; ! 1654: end; ! 1655: 22: begin { Normal intensity } ! 1656: FAttribute := FAttribute and (not F_INTENSE); ! 1657: end; ! 1658: 27: begin { Normal characters } ! 1659: FAttribute := F_WHITE; ! 1660: FReverseVideo := FALSE; ! 1661: end; ! 1662: 30, 31, 32, 33, 34, 35, 36, 37: ! 1663: begin { Foreground color } ! 1664: FAttribute := (n mod 10) or (FAttribute and $F8); ! 1665: end; ! 1666: 40, 41, 42, 43, 44, 45, 46, 47: ! 1667: begin { Background color } ! 1668: FAttribute := ((n mod 10) shl 4) or (FAttribute and $8F); ! 1669: end; ! 1670: else ! 1671: InvalidEscape('m'); ! 1672: end; ! 1673: end; ! 1674: end; ! 1675: if FReverseVideo then begin ! 1676: FAttribute := ((FAttribute and 7) shl 4) or ! 1677: ((FAttribute shr 4) and 7) or ! 1678: (FAttribute and $88); ! 1679: end; ! 1680: end; ! 1681: ! 1682: ! 1683: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1684: procedure TScreen.ProcessCSI_n_lc; { Cursor position report } ! 1685: begin ! 1686: UnimplementedEscape('n'); ! 1687: end; ! 1688: ! 1689: ! 1690: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1691: procedure TScreen.ProcessCSI_at; { Insert character } ! 1692: var ! 1693: nChar : Integer; ! 1694: nCnt : Integer; ! 1695: nCol : Integer; ! 1696: Line : TLine; ! 1697: begin ! 1698: GetEscapeParam(2, nChar); ! 1699: if nChar = 0 then ! 1700: nChar := 1; ! 1701: ! 1702: nCnt := FColCount - FCol - nChar; ! 1703: if nCnt <= 0 then begin ! 1704: Eol; ! 1705: Exit; ! 1706: end; ! 1707: ! 1708: Line := Lines[FRow]; ! 1709: for nCol := FColCount - 1 downto FCol + nChar do begin ! 1710: Line.Txt[nCol] := Line.Txt[nCol - nChar]; ! 1711: Line.Att[nCol] := Line.Att[nCol - nChar]; ! 1712: InvRect(Frow, nCol); ! 1713: end; ! 1714: ! 1715: for nCol := FCol to FCol + nChar - 1 do begin ! 1716: Line.Txt[nCol] := ' '; ! 1717: Line.Att[nCol] := FAttribute; ! 1718: InvRect(Frow, nCol); ! 1719: end; ! 1720: ! 1721: end; ! 1722: ! 1723: ! 1724: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1725: procedure TScreen.ProcessCSI_r_lc; { Scrolling margins } ! 1726: var ! 1727: From, Top, Bottom : Integer; ! 1728: begin ! 1729: From := GetEscapeParam(2, Top); ! 1730: if Top = 0 then begin { Default = full screen } ! 1731: FScrollRowTop := 0; ! 1732: FScrollRowBottom := FRowCount - 1; ! 1733: end ! 1734: else begin ! 1735: while (From <= Length(FEscBuffer)) and (FEscBuffer[From] = ' ') do ! 1736: From := From + 1; ! 1737: if FEscBuffer[From] = ';' then ! 1738: GetEscapeParam(From + 1, Bottom) ! 1739: else ! 1740: Bottom := 1; ! 1741: ! 1742: FScrollRowTop := Top - 1; ! 1743: FScrollRowBottom := Bottom - 1; ! 1744: ! 1745: if (FScrollRowBottom <= FScrollRowTop) or ! 1746: (FScrollRowTop < 0) or ! 1747: (FScrollRowBottom >= FRowCount) then begin ! 1748: FScrollRowTop := 0; ! 1749: FScrollRowBottom := FRowCount - 1; ! 1750: end; ! 1751: end; ! 1752: end; ! 1753: ! 1754: ! 1755: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1756: procedure TScreen.ProcessCSI_s_lc; { Save cursor location } ! 1757: begin ! 1758: ProcessCSI_7; ! 1759: end; ! 1760: ! 1761: ! 1762: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1763: procedure TScreen.ProcessCSI_u_lc; { Restore cursor location } ! 1764: begin ! 1765: ProcessCSI_8; ! 1766: end; ! 1767: ! 1768: ! 1769: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1770: procedure TScreen.ProcessCSI_7; { Save cursor location } ! 1771: begin ! 1772: FRowSaved := FRow; ! 1773: FColSaved := FCol; ! 1774: end; ! 1775: ! 1776: ! 1777: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1778: procedure TScreen.ProcessCSI_8; { Restore cursor location } ! 1779: begin ! 1780: if FRowSaved = -1 then ! 1781: GotoXY(0, 0) ! 1782: else ! 1783: GotoXY(FColSaved, FRowSaved); ! 1784: FRowSaved := -1; ! 1785: FColSaved := -1; ! 1786: end; ! 1787: ! 1788: ! 1789: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1790: procedure TScreen.ProcessCSI_H; { Set Cursor Position } ! 1791: var ! 1792: From, Row, Col : Integer; ! 1793: begin ! 1794: From := GetEscapeParam(2, Row); ! 1795: while (From <= Length(FEscBuffer)) and (FEscBuffer[From] = ' ') do ! 1796: From := From + 1; ! 1797: if FEscBuffer[From] = ';' then ! 1798: GetEscapeParam(From + 1, Col) ! 1799: else ! 1800: Col := 1; ! 1801: ! 1802: GotoXY(Col - 1, Row - 1); ! 1803: end; ! 1804: ! 1805: ! 1806: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1807: procedure TScreen.ProcessCSI_h_lc; { Terminal mode set } ! 1808: var ! 1809: Priv : Boolean; ! 1810: Mode : Integer; ! 1811: begin ! 1812: if FEscBuffer[1] <> '[' then begin ! 1813: UnimplementedEscape('h'); ! 1814: Exit; ! 1815: end; ! 1816: ! 1817: Priv := (FEscBuffer[2] = '?'); ! 1818: if not Priv then begin ! 1819: UnimplementedEscape('h'); ! 1820: Exit; ! 1821: end; ! 1822: ! 1823: GetEscapeParam(3, Mode); ! 1824: case Mode of ! 1825: 1 : { ANSI cursor keys } ! 1826: FCKeyMode := TRUE; ! 1827: 4 : { Smooth scroll OFF } ! 1828: { Ignore }; ! 1829: 7: { Auto-wrap OFF } ! 1830: FAutoWrap := TRUE; ! 1831: 25: { Cursor visible } ! 1832: begin ! 1833: FCursorOff := FALSE; ! 1834: if Assigned(FOnCursorVisible) then ! 1835: FOnCursorVisible(Self); ! 1836: end; ! 1837: else ! 1838: UnimplementedEscape('h'); ! 1839: end; ! 1840: end; ! 1841: ! 1842: ! 1843: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1844: procedure TScreen.ProcessCSI_l_lc; { Terminal mode reset } ! 1845: var ! 1846: Priv : Boolean; ! 1847: Mode : Integer; ! 1848: begin ! 1849: if FEscBuffer[1] <> '[' then begin ! 1850: UnimplementedEscape('l'); ! 1851: Exit; ! 1852: end; ! 1853: ! 1854: Priv := (FEscBuffer[2] = '?'); ! 1855: if not Priv then begin ! 1856: UnimplementedEscape('l'); ! 1857: Exit; ! 1858: end; ! 1859: ! 1860: GetEscapeParam(3, Mode); ! 1861: case Mode of ! 1862: 1 : { ANSI cursor keys } ! 1863: FCKeyMode := FALSE; ! 1864: 4 : { Smooth scroll OFF } ! 1865: { Ignore }; ! 1866: 7: { Auto-wrap OFF } ! 1867: FAutoWrap := FALSE; ! 1868: 25: { Cursor invisible } ! 1869: begin ! 1870: FCursorOff := TRUE; ! 1871: if Assigned(FOnCursorVisible) then ! 1872: FOnCursorVisible(Self); ! 1873: end; ! 1874: else ! 1875: UnimplementedEscape('l'); ! 1876: end; ! 1877: end; ! 1878: ! 1879: ! 1880: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1881: procedure TScreen.ProcessCSI_A; { Cursor Up } ! 1882: var ! 1883: Row : Integer; ! 1884: begin ! 1885: GetEscapeParam(2, Row); ! 1886: if Row <= 0 then ! 1887: Row := 1; ! 1888: FRow := FRow - Row; ! 1889: if FRow < 0 then ! 1890: FRow := 0; ! 1891: end; ! 1892: ! 1893: ! 1894: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1895: procedure TScreen.ProcessCSI_B; { Cursor Down } ! 1896: var ! 1897: Row : Integer; ! 1898: begin ! 1899: GetEscapeParam(2, Row); ! 1900: if Row <= 0 then ! 1901: Row := 1; ! 1902: FRow := FRow + Row; ! 1903: if FRow >= FRowCount then ! 1904: FRow := FRowCount - 1; ! 1905: end; ! 1906: ! 1907: ! 1908: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1909: procedure TScreen.ProcessCSI_C; { Cursor Right } ! 1910: var ! 1911: Col : Integer; ! 1912: begin ! 1913: GetEscapeParam(2, Col); ! 1914: if Col <= 0 then ! 1915: Col := 1; ! 1916: FCol := FCol + Col; ! 1917: if FCol >= FColCount then begin ! 1918: if FAutoWrap then begin ! 1919: FCol := FCol - FColCount; ! 1920: Inc(FRow); ! 1921: if FRow >= FRowCount then ! 1922: FRow := FRowCount - 1; ! 1923: end ! 1924: else ! 1925: FCol := FColCount - 1; ! 1926: end; ! 1927: end; ! 1928: ! 1929: ! 1930: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1931: procedure TScreen.ProcessCSI_D; { Cursor Left } ! 1932: var ! 1933: Col : Integer; ! 1934: begin ! 1935: GetEscapeParam(2, Col); ! 1936: if Col <= 0 then ! 1937: Col := 1; ! 1938: FCol := FCol - Col; ! 1939: if FCol < 0 then ! 1940: FCol := 0; ! 1941: end; ! 1942: ! 1943: ! 1944: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1945: procedure TScreen.ProcessCSI_P; { Delete Character } ! 1946: var ! 1947: Count : Integer; ! 1948: nCol : Integer; ! 1949: begin ! 1950: GetEscapeParam(2, Count); ! 1951: if Count <= 0 then ! 1952: Count := 1; ! 1953: with Lines[FRow] do begin ! 1954: for nCol := Fcol to FColCount - Count - 1 do begin ! 1955: Txt[nCol] := Txt[nCol + Count]; ! 1956: Att[nCol] := Att[nCol + Count]; ! 1957: end; ! 1958: for nCol := FcolCount - Count - 1 to FColCount - 1 do begin ! 1959: Txt[nCol] := ' '; ! 1960: Att[nCol] := F_WHITE; ! 1961: end; ! 1962: end; ! 1963: InvRect(Frow, FCol); ! 1964: InvRect(Frow, FColCount); ! 1965: end; ! 1966: ! 1967: ! 1968: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1969: procedure TScreen.ProcessCSI_S; { Scroll up } ! 1970: begin ! 1971: ScrollUp; ! 1972: end; ! 1973: ! 1974: ! 1975: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1976: procedure TScreen.ProcessCSI_T; { Scroll down } ! 1977: begin ! 1978: UnimplementedEscape('T'); ! 1979: end; ! 1980: ! 1981: ! 1982: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 1983: procedure TScreen.process_charset_G0(EscCmd : Char); { G0 character set } ! 1984: begin ! 1985: case EscCmd of ! 1986: '0': begin ! 1987: FCharSetG0 := EscCmd; ! 1988: FXlatInputTable := @ibm_iso8859_1_G1; ! 1989: FXlatOutputTable := @ibm_iso8859_1_G1; ! 1990: FNoXlat := FNoXlatInitial; ! 1991: { FNoXlat := FALSE;} ! 1992: end; ! 1993: 'B': begin ! 1994: FCharSetG0 := EscCmd; ! 1995: FXlatInputTable := @ibm_iso8859_1_G0; ! 1996: FXlatOutputTable := @ibm_iso8859_1_G0; ! 1997: FNoXlat := FNoXlatInitial; ! 1998: end; ! 1999: else ! 2000: InvalidEscape(EscCmd); ! 2001: end; ! 2002: end; ! 2003: ! 2004: ! 2005: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2006: procedure TScreen.process_charset_G1(EscCmd : Char); { G1 character set } ! 2007: begin ! 2008: FCharSetG1 := EscCmd; ! 2009: end; ! 2010: ! 2011: ! 2012: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2013: procedure TScreen.process_charset_G2(EscCmd : Char); { G2 character set } ! 2014: begin ! 2015: FCharSetG2 := EscCmd; ! 2016: end; ! 2017: ! 2018: ! 2019: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2020: procedure TScreen.process_charset_G3(EscCmd : Char); { G2 character set } ! 2021: begin ! 2022: FCharSetG3 := EscCmd; ! 2023: end; ! 2024: ! 2025: ! 2026: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2027: procedure TScreen.ProcessEscape(EscCmd : Char); ! 2028: begin ! 2029: if Length(FEscBuffer) = 0 then begin ! 2030: case EscCmd of ! 2031: 'D': ProcessESC_D; { Index } ! 2032: 'M': ProcessESC_M; { Reverse index } ! 2033: 'E': ProcessESC_E; { Next line } ! 2034: 'H': ; { Tabulation set } ! 2035: '7': ProcessCSI_7; { Save cursor } ! 2036: '8': ProcessCSI_8; { Restore Cursor } ! 2037: '=': ; { VT52 } { Enter Alternate keypad } ! 2038: '>': ; { VT52 } { Exit Alternate keypad } ! 2039: '<': ; { VT52 } { Enter ANSI mode } ! 2040: else ! 2041: InvalidEscape(EscCmd); ! 2042: WriteLiteralChar(EscCmd); ! 2043: end; ! 2044: ! 2045: Exit; ! 2046: end; ! 2047: ! 2048: case FEscBuffer[1] of ! 2049: ' ': begin ! 2050: case EscCmd of ! 2051: 'F': ; ! 2052: else ! 2053: InvalidEscape(EscCmd); ! 2054: end; ! 2055: end; ! 2056: '[': begin ! 2057: case EscCmd of ! 2058: 'I': ProcessCSI_I; { Select IBM char set } ! 2059: { Extension F. Piette !! } ! 2060: 'J': ProcessCSI_J; { Clear the screen } ! 2061: 'K': ProcessCSI_K; { Erase to End of Line } ! 2062: 'L': ProcessCSI_L; { Insert Line } ! 2063: 'M': ProcessCSI_M; { Delete Line } ! 2064: 'm': ProcessCSI_m_lc; { Select Attributes } ! 2065: 'n': ProcessCSI_n_lc; { Cursor position report } ! 2066: '@': ProcessCSI_at; { Insert character } ! 2067: 'r': ProcessCSI_r_lc; { Set Top and Bottom marg } ! 2068: 's': ProcessCSI_s_lc; { Save cursor location } ! 2069: 'u': ProcessCSI_u_lc; { Restore cursor location } ! 2070: 'H': ProcessCSI_H; { Set Cursor Position } ! 2071: 'f': ProcessCSI_H; { Set Cursor Position } ! 2072: 'g': ; { Tabulation Clear } ! 2073: 'h': ProcessCSI_h_lc; { Terminal mode set } ! 2074: 'l': ProcessCSI_l_lc; { Terminal mode reset } ! 2075: 'A': ProcessCSI_A; { Cursor Up } ! 2076: 'B': ProcessCSI_B; { Cursor Down } ! 2077: 'C': ProcessCSI_C; { Cursor Right } ! 2078: 'D': ProcessCSI_D; { Cursor Left } ! 2079: 'P': ProcessCSI_P; { Delete Character } ! 2080: 'S': ProcessCSI_S; { Scroll up } ! 2081: 'T': ProcessCSI_T; { Scroll down } ! 2082: '>': ; { } ! 2083: else ! 2084: InvalidEscape(EscCmd); ! 2085: end; ! 2086: end; ! 2087: '(': process_charset_G0(EscCmd); { G0 character set } ! 2088: ')': process_charset_G1(EscCmd); { G1 character set } ! 2089: '*': process_charset_G2(EscCmd); { G2 character set } ! 2090: '+': process_charset_G3(EscCmd); { G3 character set } ! 2091: else ! 2092: InvalidEscape(EscCmd); ! 2093: end; ! 2094: end; ! 2095: ! 2096: ! 2097: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2098: procedure TScreen.WriteLiteralChar(Ch : Char); ! 2099: var ! 2100: Line : TLine; ! 2101: begin ! 2102: if FCol >= FColCount then begin ! 2103: if FAutoWrap then begin ! 2104: FCol := 0; ! 2105: Inc(FRow); ! 2106: if FRow >= FRowCount then begin ! 2107: Dec(FRow); ! 2108: ScrollUp; ! 2109: end; ! 2110: end; ! 2111: end; ! 2112: ! 2113: if FForceHighBit then ! 2114: Ch := Chr(ord(ch) or $80); ! 2115: ! 2116: Line := Lines[FRow]; ! 2117: Line.Txt[FCol] := Ch; ! 2118: Line.Att[FCol] := FAttribute; ! 2119: InvRect(Frow, FCol); ! 2120: ! 2121: if FCol < High(Line.Txt) then ! 2122: Inc(FCol); ! 2123: end; ! 2124: ! 2125: ! 2126: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2127: procedure TScreen.SetAttr(Att : Char); ! 2128: begin ! 2129: { Not implemented } ! 2130: end; ! 2131: ! 2132: ! 2133: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2134: { Write a single character at current cursor location. } ! 2135: { Update cursor position. } ! 2136: procedure TScreen.WriteChar(Ch : Char); ! 2137: var ! 2138: bProcess : Boolean; ! 2139: begin ! 2140: if FCntLiteral > 0 then begin ! 2141: if (FCntLiteral and 1) <> 0 then ! 2142: WriteLiteralChar(Ch) ! 2143: else ! 2144: SetAttr(Ch); ! 2145: Dec(FCntLiteral); ! 2146: Exit; ! 2147: end; ! 2148: ! 2149: if FNoXlat then ! 2150: Ch := FXlatInputTable^[ord(Ch)]; ! 2151: ! 2152: if FEscFLag then begin ! 2153: bProcess := FALSE; ! 2154: if (Length(FEscBuffer) = 0) and ! 2155: (Ch in ['D', 'M', 'E', 'H', '7', '8', '=', '>', '<']) then ! 2156: bProcess := TRUE ! 2157: else if (Length(FEscBuffer) = 1) and ! 2158: (FEscBuffer[1] in ['(', ')', '*', '+']) then ! 2159: bProcess := TRUE ! 2160: else if (Ch in ['0'..'9', ';', '?', ' ']) or ! 2161: ((Length(FEscBuffer) = 0) and ! 2162: (ch in ['[', '(', ')', '*', '+'])) then begin ! 2163: FEscBuffer := FEscBuffer + Ch; ! 2164: if Length(FEscBuffer) >= High(FEscBuffer) then begin ! 2165: MessageBeep(MB_ICONASTERISK); ! 2166: FEscBuffer := ''; ! 2167: FEscFlag := FALSE; ! 2168: end; ! 2169: end ! 2170: else ! 2171: bProcess := TRUE; ! 2172: ! 2173: if bProcess then begin ! 2174: ProcessEscape(Ch); ! 2175: FEscBuffer := ''; ! 2176: FEscFlag := FALSE; ! 2177: end; ! 2178: ! 2179: Exit; ! 2180: end; ! 2181: ! 2182: case Ch of ! 2183: #0: ; ! 2184: #7: MessageBeep(MB_ICONASTERISK); ! 2185: #8: BackSpace; ! 2186: #9: begin ! 2187: repeat ! 2188: Inc(FCol); ! 2189: until (FCol Mod 8) = 0; ! 2190: end; ! 2191: #10: begin ! 2192: CursorDown; ! 2193: if FAutoCR then ! 2194: CarriageReturn; ! 2195: end; ! 2196: #13: begin ! 2197: CarriageReturn; ! 2198: if FAutoLF then ! 2199: CursorDown; ! 2200: end; ! 2201: #14: begin ! 2202: FXlatInputTable := @ibm_iso8859_1_G1; ! 2203: FXlatOutputTable := @ibm_iso8859_1_G1; ! 2204: end; ! 2205: #15: begin ! 2206: FXlatInputTable := @ibm_iso8859_1_G0; ! 2207: FXlatOutputTable := @ibm_iso8859_1_G0; ! 2208: end; ! 2209: #27: begin ! 2210: FEscBuffer := ''; ! 2211: FEscFlag := TRUE; ! 2212: end; ! 2213: else ! 2214: WriteLiteralChar(Ch); ! 2215: end; ! 2216: end; ! 2217: ! 2218: ! 2219: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2220: { Write characters at current cursor location. Update cursor position. } ! 2221: procedure TScreen.WriteStr(Str : String); ! 2222: var ! 2223: I : Integer; ! 2224: begin ! 2225: for I := 1 to Length(Str) do ! 2226: WriteChar(Str[I]); ! 2227: end; ! 2228: ! 2229: ! 2230: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2231: { Read characters from the cursor to end of line } ! 2232: function TScreen.ReadStr : String; ! 2233: var ! 2234: Line : TLine; ! 2235: Len : Integer; ! 2236: begin ! 2237: Line := Lines[FRow]; ! 2238: Len := FColCount - FCol; ! 2239: if Len <= 0 then ! 2240: Result := '' ! 2241: else begin ! 2242: SetLength(Result, Len); ! 2243: Move(Line.Txt[FCol], Result[1], Len); ! 2244: end; ! 2245: end; ! 2246: ! 2247: ! 2248: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2249: procedure TScreen.GotoXY(X, Y : Integer); ! 2250: begin ! 2251: if X < 0 then ! 2252: FCol := 0 ! 2253: else if X >= FColCount then ! 2254: FCol := FColCount - 1 ! 2255: else ! 2256: FCol := X; ! 2257: ! 2258: if Y < 0 then ! 2259: FRow := 0 ! 2260: else if Y >= FRowCount then ! 2261: FRow := FRowCount - 1 ! 2262: else ! 2263: FRow := Y; ! 2264: end; ! 2265: ! 2266: ! 2267: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2268: procedure TCustomEmulVT.SetCaret; ! 2269: begin ! 2270: {$IFDEF CHAR_ZOOM} ! 2271: SetCaretPos(FCharPos[FScreen.FCol] + LeftMargin + 2, ! 2272: FLinePos[FScreen.FRow - FTopLine] + TopMargin + 3); ! 2273: {$ELSE} ! 2274: SetCaretPos(FScreen.FCol * FCharWidth + LeftMargin, ! 2275: (FScreen.FRow - FTopLine) * FLineHeight + TopMargin); ! 2276: {$ENDIF} ! 2277: end; ! 2278: ! 2279: ! 2280: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2281: { Adjusts the scrollbar properties to match the number of host and scrollback ! 2282: lines that we can scroll through. } ! 2283: procedure TCustomEmulVT.AdjustScrollBar; ! 2284: var ! 2285: VisibleLines : Integer; ! 2286: begin ! 2287: FVScrollBar.Min := FScreen.FBackEndRow; ! 2288: {$IFDEF CHAR_ZOOM} ! 2289: VisibleLines := Trunc((Height - TopMargin - BottomMargin) / (LineHeight * FLineZoom)); ! 2290: {$ELSE} ! 2291: VisibleLines := (Height - TopMargin - BottomMargin) Div LineHeight; ! 2292: {$ENDIF} ! 2293: if VisibleLines > FScreen.FRowCount then ! 2294: VisibleLines := FScreen.FRowCount; ! 2295: FVScrollBar.Max := FScreen.FRowCount - VisibleLines; ! 2296: FVScrollBar.Position := FTopLine; ! 2297: FVScrollBar.SmallChange := 1; ! 2298: FVScrollBar.LargeChange := VisibleLines; ! 2299: FVScrollBar.Enabled := FVScrollBar.Max > FVScrollBar.Min; ! 2300: end; ! 2301: ! 2302: ! 2303: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2304: procedure TCustomEmulVT.Clear; ! 2305: begin ! 2306: FScreen.ClearScreen; ! 2307: end; ! 2308: ! 2309: ! 2310: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2311: procedure TCustomEmulVT.SetCursor(Row, Col : Integer); ! 2312: begin ! 2313: FScreen.GotoXY(Col - 1, Row - 1); ! 2314: { SetCaret; } ! 2315: end; ! 2316: ! 2317: ! 2318: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2319: procedure TCustomEmulVT.WriteChar(Ch : Char); ! 2320: begin ! 2321: if FCaretCreated and FCaretShown then begin ! 2322: HideCaret(Handle); ! 2323: FCaretShown := FALSE; ! 2324: end; ! 2325: ! 2326: if FLog then ! 2327: Write(FFileHandle, Ch); ! 2328: FScreen.WriteChar(ch); ! 2329: if FAutoRepaint then ! 2330: UpdateScreen; ! 2331: { SetCaret; } ! 2332: end; ! 2333: ! 2334: ! 2335: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2336: procedure TCustomEmulVT.WriteStr(Str : String); ! 2337: var ! 2338: I : Integer; ! 2339: begin ! 2340: if FCaretCreated and FCaretShown then begin ! 2341: HideCaret(Handle); ! 2342: FCaretShown := FALSE; ! 2343: end; ! 2344: ! 2345: for I := 1 to Length(Str) do begin ! 2346: if FLog then ! 2347: Write(FFileHandle, Str[I]); ! 2348: FScreen.WriteChar(Str[I]); ! 2349: end; ! 2350: if FAutoRepaint then ! 2351: UpdateScreen; ! 2352: { SetCaret; } ! 2353: end; ! 2354: ! 2355: ! 2356: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2357: procedure TCustomEmulVT.WriteBuffer(Buffer : Pointer; Len : Integer); ! 2358: var ! 2359: I : Integer; ! 2360: begin ! 2361: if FCaretCreated and FCaretShown then begin ! 2362: HideCaret(Handle); ! 2363: FCaretShown := FALSE; ! 2364: end; ! 2365: ! 2366: for I := 0 to Len - 1 do begin ! 2367: if FLog then ! 2368: Write(FFileHandle, PChar(Buffer)[I]); ! 2369: FScreen.WriteChar(PChar(Buffer)[I]); ! 2370: end; ! 2371: if FAutoRepaint then ! 2372: UpdateScreen; ! 2373: { SetCaret; } ! 2374: end; ! 2375: ! 2376: ! 2377: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2378: function TCustomEmulVT.ReadStr : String; ! 2379: begin ! 2380: Result := FScreen.ReadStr; ! 2381: end; ! 2382: ! 2383: ! 2384: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2385: procedure TCustomEmulVT.CopyHostScreen; ! 2386: begin ! 2387: FScreen.CopyScreenToBack; ! 2388: AdjustScrollBar; ! 2389: end; ! 2390: ! 2391: ! 2392: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2393: constructor TCustomEmulVT.Create(AOwner: TComponent); ! 2394: type ! 2395: TMyLogPalette = record ! 2396: palVersion: Word; ! 2397: palNumEntries: Word; ! 2398: palPalEntry: array[0..NumPaletteEntries - 1] of TPaletteEntry; ! 2399: end; ! 2400: TPLogPalette = ^TLogPalette; ! 2401: var ! 2402: plgpl : ^TMyLogPalette; ! 2403: I : Integer; ! 2404: begin ! 2405: inherited Create(AOwner); ! 2406: ControlStyle := ControlStyle + [csOpaque]; ! 2407: ! 2408: New(plgpl); ! 2409: plgpl^.palNumEntries := High(plgpl^.palPalEntry) + 1; ! 2410: plgpl^.palVersion := $300; ! 2411: ! 2412: FPaletteEntries[0].peRed := 0; { Black } ! 2413: FPaletteEntries[0].peGreen := 0; ! 2414: FPaletteEntries[0].peBlue := 0; ! 2415: FPaletteEntries[1].peRed := 168; { Red } ! 2416: FPaletteEntries[1].peGreen := 0; ! 2417: FPaletteEntries[1].peBlue := 0; ! 2418: FPaletteEntries[2].peRed := 0; { Green } ! 2419: FPaletteEntries[2].peGreen := 168; ! 2420: FPaletteEntries[2].peBlue := 0; ! 2421: FPaletteEntries[3].peRed := 168; { Yellow } ! 2422: FPaletteEntries[3].peGreen := 168; ! 2423: FPaletteEntries[3].peBlue := 0; ! 2424: FPaletteEntries[4].peRed := 0; { Dark Blue } ! 2425: FPaletteEntries[4].peGreen := 0; ! 2426: FPaletteEntries[4].peBlue := 168; ! 2427: FPaletteEntries[5].peRed := 168; { Magenta } ! 2428: FPaletteEntries[5].peGreen := 0; ! 2429: FPaletteEntries[5].peBlue := 168; ! 2430: FPaletteEntries[6].peRed := 0; { Cyan } ! 2431: FPaletteEntries[6].peGreen := 112; ! 2432: FPaletteEntries[6].peBlue := 216; ! 2433: FPaletteEntries[7].peRed := 200; { White } ! 2434: FPaletteEntries[7].peGreen := 200; ! 2435: FPaletteEntries[7].peBlue := 200; ! 2436: FPaletteEntries[8].peRed := 84; { Grey } ! 2437: FPaletteEntries[8].peGreen := 84; ! 2438: FPaletteEntries[8].peBlue := 84; ! 2439: FPaletteEntries[9].peRed := 84; { Red Highlight } ! 2440: FPaletteEntries[9].peGreen := 84; ! 2441: FPaletteEntries[9].peBlue := 212; ! 2442: FPaletteEntries[10].peRed := 84; { Green Highlight } ! 2443: FPaletteEntries[10].peGreen := 255; ! 2444: FPaletteEntries[10].peBlue := 84; ! 2445: FPaletteEntries[11].peRed := 255; { Yellow Highlight } ! 2446: FPaletteEntries[11].peGreen := 255; ! 2447: FPaletteEntries[11].peBlue := 84; ! 2448: FPaletteEntries[12].peRed := 84; { Blue Highlight } ! 2449: FPaletteEntries[12].peGreen := 84; ! 2450: FPaletteEntries[12].peBlue := 255; ! 2451: FPaletteEntries[13].peRed := 255; { Magenta Highlight } ! 2452: FPaletteEntries[13].peGreen := 84; ! 2453: FPaletteEntries[13].peBlue := 255; ! 2454: FPaletteEntries[14].peRed := 84; { Cyan highlight } ! 2455: FPaletteEntries[14].peGreen := 255; ! 2456: FPaletteEntries[14].peBlue := 255; ! 2457: FPaletteEntries[15].peRed := 255; { White Highlight } ! 2458: FPaletteEntries[15].peGreen := 255; ! 2459: FPaletteEntries[15].peBlue := 255; ! 2460: ! 2461: for I := 0 to High(plgpl^.palPalEntry) do begin ! 2462: plgpl^.PalPalEntry[I].peRed := FPaletteEntries[I].peRed; ! 2463: plgpl^.PalPalEntry[I].peGreen := FPaletteEntries[I].peGreen; ! 2464: plgpl^.PalPalEntry[I].peBlue := FPaletteEntries[I].peBlue; ! 2465: plgpl^.PalPalEntry[I].peFlags := PC_NOCOLLAPSE; ! 2466: end; ! 2467: ! 2468: FPal := CreatePalette(TPLogPalette(plgpl)^); ! 2469: Dispose(plgpl); ! 2470: ! 2471: FScreen := TScreen.Create; ! 2472: FVScrollBar := TScrollBar.Create(Self); ! 2473: FFont := TFont.Create; ! 2474: FFont.Name := 'Terminal'; ! 2475: FFont.Size := 12; ! 2476: FFont.Style := []; ! 2477: FCharZoom := 1.0; ! 2478: FLineZoom := 1.0; ! 2479: SetupFont; ! 2480: ! 2481: FScreen.FXlatInputTable := @ibm_iso8859_1_G0; ! 2482: FScreen.FXlatOutputTable := @ibm_iso8859_1_G0; ! 2483: FScreen.OnCursorVisible := CursorVisibleEvent; ! 2484: ! 2485: FCursorVisible := TRUE; ! 2486: Width := 250; ! 2487: Height := 100; ! 2488: FBorderStyle := bsSingle; ! 2489: FBorderWidth := 1; ! 2490: FAutoRepaint := TRUE; ! 2491: FFkeys := 1; ! 2492: FGraphicDraw := FALSE; ! 2493: ! 2494: with FVScrollBar do begin ! 2495: Parent := Self; ! 2496: Kind := sbVertical; ! 2497: Width := 16; ! 2498: Visible := TRUE; ! 2499: Align := alRight; ! 2500: OnScroll := VScrollBarScroll; ! 2501: end; ! 2502: AdjustScrollBar; ! 2503: ! 2504: with FScreen do begin ! 2505: GotoXY(0, 0); ! 2506: WriteStr('EmulVT'); ! 2507: GotoXY(0, 1); ! 2508: end; ! 2509: end; ! 2510: ! 2511: ! 2512: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2513: procedure TCustomEmulVT.SetRows(Value : Integer); ! 2514: begin ! 2515: with FScreen do begin ! 2516: if FRowCount <> Value then begin ! 2517: SetRowCount(Value); ! 2518: AdjustScrollBar; ! 2519: ClearScreen; ! 2520: Repaint; ! 2521: end; ! 2522: end; ! 2523: end; ! 2524: ! 2525: ! 2526: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2527: function TCustomEmulVT.GetRows : Integer; ! 2528: begin ! 2529: Result := FScreen.FRowCount; ! 2530: end; ! 2531: ! 2532: ! 2533: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2534: procedure TCustomEmulVT.SetCols(Value : Integer); ! 2535: begin ! 2536: with FScreen do begin ! 2537: if FColCount <> Value then begin ! 2538: FColCount := Value; ! 2539: ClearScreen; ! 2540: Repaint; ! 2541: end; ! 2542: end; ! 2543: end; ! 2544: ! 2545: ! 2546: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2547: function TCustomEmulVT.GetCols : Integer; ! 2548: begin ! 2549: Result := FScreen.FColCount; ! 2550: end; ! 2551: ! 2552: ! 2553: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2554: procedure TCustomEmulVT.CursorVisibleEvent(Sender : TObject); ! 2555: begin ! 2556: if FScreen.FCursorOff then begin ! 2557: if FCaretShown then begin ! 2558: HideCaret(Handle); ! 2559: FCaretShown := FALSE; ! 2560: end; ! 2561: end ! 2562: else begin ! 2563: if FScreen.Focused and not FCaretShown then begin ! 2564: ShowCaret(Handle); ! 2565: FCaretShown := TRUE; ! 2566: end; ! 2567: end; ! 2568: end; ! 2569: ! 2570: ! 2571: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2572: procedure TCustomEmulVT.SetAutoLF(Value : Boolean); ! 2573: begin ! 2574: FScreen.FAutoLF := Value; ! 2575: end; ! 2576: ! 2577: ! 2578: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2579: procedure TCustomEmulVT.SetAutoCR(Value : Boolean); ! 2580: begin ! 2581: FScreen.FAutoCR := Value; ! 2582: end; ! 2583: ! 2584: ! 2585: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2586: procedure TCustomEmulVT.SetLog(Value : Boolean); ! 2587: begin ! 2588: if FLog = Value then ! 2589: Exit; ! 2590: ! 2591: FLog := Value; ! 2592: ! 2593: if FLog then begin ! 2594: {$I-} ! 2595: AssignFile(FFileHandle, 'EMULVT.LOG'); ! 2596: Append(FFileHandle); ! 2597: if IOResult <> 0 then ! 2598: Rewrite(FFileHandle); ! 2599: Write(FFileHandle, '<Open>'); ! 2600: {$I+} ! 2601: end ! 2602: else begin ! 2603: Write(FFileHandle, '<Close>'); ! 2604: CloseFile(FFileHandle); ! 2605: end; ! 2606: end; ! 2607: ! 2608: ! 2609: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2610: procedure TCustomEmulVT.SetXlat(Value : Boolean); ! 2611: begin ! 2612: FScreen.FNoXlat := not Value; ! 2613: FScreen.FNoXlatInitial := not Value; ! 2614: end; ! 2615: ! 2616: ! 2617: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2618: function TCustomEmulVT.GetXlat : Boolean; ! 2619: begin ! 2620: Result := not FScreen.FNoXlatInitial; ! 2621: end; ! 2622: ! 2623: ! 2624: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2625: function TCustomEmulVT.GetAutoLF : Boolean; ! 2626: begin ! 2627: Result := FScreen.FAutoLF; ! 2628: end; ! 2629: ! 2630: ! 2631: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2632: function TCustomEmulVT.GetAutoCR : Boolean; ! 2633: begin ! 2634: Result := FScreen.FAutoCR; ! 2635: end; ! 2636: ! 2637: ! 2638: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2639: destructor TCustomEmulVT.Destroy; ! 2640: begin ! 2641: if FLog then ! 2642: Log := FALSE; ! 2643: ! 2644: FFont.Free; ! 2645: FVScrollBar.Free; ! 2646: FScreen.Free; ! 2647: DeleteObject(FPal); ! 2648: inherited Destroy; ! 2649: end; ! 2650: ! 2651: ! 2652: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2653: procedure TCustomEmulVT.SetBackRows(Value : Integer); ! 2654: begin ! 2655: with FScreen do begin ! 2656: if FBackRowCount <> Value then begin ! 2657: SetBackRowCount(Value); ! 2658: AdjustScrollBar; ! 2659: end; ! 2660: end; ! 2661: end; ! 2662: ! 2663: ! 2664: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2665: procedure TCustomEmulVT.SetTopLine(Value : Integer); ! 2666: begin ! 2667: if Value < FVScrollBar.Min then ! 2668: Value := FVScrollBar.Min; ! 2669: if Value > FVScrollBar.Max then ! 2670: Value := FVScrollBar.Max; ! 2671: FTopLine := Value; ! 2672: FVScrollBar.Position := FTopLine; ! 2673: Repaint; ! 2674: end; ! 2675: ! 2676: ! 2677: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2678: function TCustomEmulVT.GetBackRows : Integer; ! 2679: begin ! 2680: Result := FScreen.FBackRowCount; ! 2681: end; ! 2682: ! 2683: ! 2684: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2685: procedure TCustomEmulVT.SetBackColor(Value : TBackColors); ! 2686: begin ! 2687: FScreen.FBackColor := Value; ! 2688: end; ! 2689: ! 2690: ! 2691: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2692: function TCustomEmulVT.GetBackColor : TBackColors; ! 2693: begin ! 2694: Result := FScreen.FBackColor; ! 2695: end; ! 2696: ! 2697: ! 2698: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2699: procedure TCustomEmulVT.SetOptions(Value : TScreenOptions); ! 2700: begin ! 2701: FScreen.FOptions := Value; ! 2702: end; ! 2703: ! 2704: ! 2705: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2706: function TCustomEmulVT.GetOptions : TScreenOptions; ! 2707: begin ! 2708: Result := FScreen.FOptions; ! 2709: end; ! 2710: ! 2711: ! 2712: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2713: procedure TCustomEmulVT.SetupFont; ! 2714: var ! 2715: DC : HDC; ! 2716: Metrics : TTextMetric; ! 2717: hObject : THandle; ! 2718: begin ! 2719: DC := GetDC(0); ! 2720: hObject := SelectObject(DC, FFont.Handle); ! 2721: GetTextMetrics(DC, Metrics); ! 2722: SelectObject(DC, hOBject); ! 2723: ReleaseDC(0, DC); ! 2724: ! 2725: SetCharWidth(Metrics.tmMaxCharWidth); ! 2726: SetLineHeight(Metrics.tmHeight); ! 2727: FInternalLeading := Metrics.tmInternalLeading; ! 2728: end; ! 2729: ! 2730: ! 2731: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2732: procedure TCustomEmulVT.SetCharWidth(newValue : Integer); ! 2733: var ! 2734: nCol : Integer; ! 2735: begin ! 2736: FCharWidth := newValue; ! 2737: for nCol := Low(FCharPos) to High(FCharPos) do ! 2738: FCharPos[nCol] := Trunc(FCharWidth * nCol * FCharZoom); ! 2739: end; ! 2740: ! 2741: ! 2742: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2743: procedure TCustomEmulVT.SetCharZoom(newValue : Single); ! 2744: begin ! 2745: FCharZoom := newValue; ! 2746: SetCharWidth(FCharWidth); ! 2747: end; ! 2748: ! 2749: ! 2750: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2751: procedure TCustomEmulVT.SetLineHeight(Value : Integer); ! 2752: var ! 2753: nRow : Integer; ! 2754: begin ! 2755: FLineHeight := Value; ! 2756: for nRow := 0 to MAX_ROW do ! 2757: FLinePos[nRow] := Trunc(FLineHeight * nRow * FLineZoom); ! 2758: end; ! 2759: ! 2760: ! 2761: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2762: procedure TCustomEmulVT.SetLineZoom(newValue : Single); ! 2763: begin ! 2764: FLineZoom := newValue; ! 2765: SetLineHeight(FLineHeight); ! 2766: end; ! 2767: ! 2768: ! 2769: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2770: procedure TCustomEmulVT.SetFont(Value : TFont); ! 2771: begin ! 2772: FFont.Assign(Value); ! 2773: {$IFNDEF SINGLE_CHAR_PAINT} ! 2774: FFont.Pitch := fpFixed; ! 2775: {$ENDIF} ! 2776: SetupFont; ! 2777: SetCaret; ! 2778: end; ! 2779: ! 2780: ! 2781: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2782: procedure TCustomEmulVT.WMLButtonDown(var Message: TWMLButtonDown); ! 2783: begin ! 2784: inherited; ! 2785: SetFocus; ! 2786: end; ! 2787: ! 2788: ! 2789: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2790: procedure TCustomEmulVT.VScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); ! 2791: begin ! 2792: FTopLine := ScrollPos; ! 2793: Repaint; ! 2794: SetFocus; ! 2795: end; ! 2796: ! 2797: ! 2798: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2799: procedure TCustomEmulVT.DoKeyBuffer(Buffer : PChar; Len : Integer); ! 2800: var ! 2801: J : Integer; ! 2802: ch : Char; ! 2803: begin ! 2804: if Assigned(FOnKeyBuffer) then ! 2805: FOnKeyBuffer(Self, Buffer, Len) ! 2806: else begin ! 2807: for J := 0 to Len - 1 do begin ! 2808: ch := Buffer[J]; ! 2809: KeyPress(ch); ! 2810: end; ! 2811: end; ! 2812: end; ! 2813: ! 2814: ! 2815: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2816: function TCustomEmulVT.FindFKeys(ScanCode: Char; Shift: TShiftState; ! 2817: Ext: Boolean) : PFuncKeyValue; ! 2818: var ! 2819: I : Integer; ! 2820: pFKeys : PFuncKeysTable; ! 2821: begin ! 2822: Result := nil; ! 2823: case FKeys of ! 2824: 0 : pFKeys := @FKeys1; ! 2825: 1 : pFKeys := @FKeys2; ! 2826: 2 : pFKeys := @FKeys3; ! 2827: else ! 2828: pFKeys := @FKeys2; ! 2829: end; ! 2830: ! 2831: for I := Low(pFKeys^) to High(pFKeys^) do begin ! 2832: if (pFKeys^[I].ScanCode <> #0) and (pFKeys^[I].ScanCode = ScanCode) and ! 2833: (pFKeys^[I].Shift = Shift) and ! 2834: (pFKeys^[I].Ext = Ext) then begin ! 2835: Result := @pFKeys^[I].Value; ! 2836: Break; ! 2837: end; ! 2838: end; ! 2839: end; ! 2840: ! 2841: ! 2842: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2843: function TCustomEmulVT.ProcessFKeys(ScanCode: Char; Shift: TShiftState; ! 2844: Ext: Boolean) : Boolean; ! 2845: var ! 2846: I : Integer; ! 2847: pFKeys : PFuncKeysTable; ! 2848: begin ! 2849: Result := FALSE; ! 2850: case FKeys of ! 2851: 0 : pFKeys := @FKeys1; ! 2852: 1 : pFKeys := @FKeys2; ! 2853: 2 : pFKeys := @FKeys3; ! 2854: else ! 2855: pFKeys := @FKeys2; ! 2856: end; ! 2857: ! 2858: for I := Low(pFKeys^) to High(pFKeys^) do begin ! 2859: if (pFKeys^[I].ScanCode <> #0) and (pFKeys^[I].ScanCode = ScanCode) and ! 2860: (pFKeys^[I].Shift = Shift) and ! 2861: (pFKeys^[I].Ext = Ext) then begin ! 2862: Result := TRUE; ! 2863: DoKeyBuffer(@pFKeys^[I].Value[1], Length(pFKeys^[I].Value)); ! 2864: Break; ! 2865: end; ! 2866: end; ! 2867: end; ! 2868: ! 2869: ! 2870: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 2871: procedure TCustomEmulVT.AppMessageHandler(var Msg: TMsg; var Handled: Boolean); ! 2872: const ! 2873: v1 : String = 'aeiou'; ! 2874: v2 : String = '�����'; ! 2875: v3 : String = '�����'; ! 2876: SpyFlag : Boolean = FALSE; ! 2877: var ! 2878: Shift : TShiftState; ! 2879: ShiftLock : Boolean; ! 2880: VirtKey : Integer; ! 2881: Key : Char; ! 2882: I : Integer; ! 2883: ScanCode : Char; ! 2884: Ext : Boolean; ! 2885: SpyBuffer : String; ! 2886: FnBuffer : String; ! 2887: pFV : PFuncKeyValue; ! 2888: begin ! 2889: if (Msg.hWnd = Handle) and (Msg.Message = WM_KEYDOWN) then begin ! 2890: VirtKey := Msg.wParam; ! 2891: Key := chr(Msg.wParam and $FF); ! 2892: { DebugString('AppMessageHandler KEYDOWN ' + IntToHex(Msg.wParam, 4) + #13 + #10); } ! 2893: Shift := KeyDataToShiftState(Msg.lParam); ! 2894: ShiftLock := ((GetKeyState(VK_CAPITAL) and 1) > 0); ! 2895: ScanCode := Chr(LOBYTE(HIWORD(Msg.lParam))); ! 2896: Ext := ((Msg.lParam and $1000000) <> 0); ! 2897: ! 2898: if Assigned(FOnKeyDown) then begin ! 2899: FOnKeyDown(Self, VirtKey, Shift, ShiftLock, ScanCode, Ext); ! 2900: if VirtKey = 0 then begin ! 2901: Handled := TRUE; ! 2902: Exit; ! 2903: end; ! 2904: end; ! 2905: ! 2906: if (Msg.wParam <> VK_SHIFT) and ! 2907: (Msg.wParam <> VK_CONTROL) and ! 2908: (Msg.wParam <> VK_MENU) then begin ! 2909: if (ScanCode = '7') and ! 2910: (Shift = [ssAlt, ssCtrl]) and (Ext = FALSE) then begin ! 2911: { This is CTRL-ALT-* (on num pad) } ! 2912: SpyFlag := TRUE; ! 2913: Handled := TRUE; ! 2914: Exit; ! 2915: end; ! 2916: ! 2917: if SpyFlag then begin ! 2918: SpyFlag := FALSE; ! 2919: pFV := FindFKeys(ScanCode, Shift, Ext); ! 2920: SpyBuffer := IntToHex(Ord(ScanCode), 2) + ', ' + ! 2921: ShiftStateToString(Shift) + ', '; ! 2922: ! 2923: if Ext then ! 2924: SpyBuffer := SpyBuffer + 'TRUE' ! 2925: else ! 2926: SpyBuffer := SpyBuffer + 'FALSE'; ! 2927: ! 2928: if pFV <> nil then ! 2929: SpyBuffer := SpyBuffer + ', ''' + ! 2930: FuncKeyValueToString(pFV^) + ''''; ! 2931: ! 2932: SpyBuffer := SpyBuffer + #0; ! 2933: ClipBoard.SetTextBuf(@SpyBuffer[1]); ! 2934: ! 2935: FnBuffer := 'Key definition from tnchrk' + ! 2936: IntToStr(FKeys) + '.cfg' + #0; ! 2937: Application.MessageBox(@SpyBuffer[1], @FnBuffer[1], MB_OK); ! 2938: Handled := TRUE; ! 2939: Exit; ! 2940: end; ! 2941: ! 2942: if ProcessFKeys(ScanCode, Shift, Ext) then begin ! 2943: Handled := TRUE; ! 2944: Exit; ! 2945: end; ! 2946: end; ! 2947: ! 2948: case Msg.wParam of ! 2949: VK_SHIFT, VK_CONTROL, VK_MENU: ; ! 2950: ! 2951: VK_NEXT, VK_PRIOR, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_HOME, VK_END: ! 2952: begin ! 2953: if ProcessFKeys(ScanCode, Shift, TRUE) then begin ! 2954: Handled := TRUE; ! 2955: Exit; ! 2956: end; ! 2957: end; ! 2958: VK_TAB, VK_RETURN, VK_ESCAPE, VK_BACK: ! 2959: begin ! 2960: Handled := TRUE; ! 2961: end; ! 2962: ! 2963: $DD: ! 2964: begin ! 2965: if not (ssAlt in Shift) then begin ! 2966: Key := #0; ! 2967: Handled := TRUE; ! 2968: if (ssShift in Shift) then ! 2969: FFlagTrema := TRUE ! 2970: else ! 2971: FFlagCirconflexe := TRUE; ! 2972: end; ! 2973: end; ! 2974: ! 2975: ord('A')..ord('Z') : ! 2976: begin ! 2977: if (ssCtrl in Shift) then ! 2978: Key := chr(Word(Key) and $1F) ! 2979: else if not ShiftLock and not (ssShift in Shift) then ! 2980: Key := chr(Word(Key) or $20); ! 2981: if (FFlagCirconflexe) then begin ! 2982: for I := Length(v1) downto 1 do begin ! 2983: if Key = v1[I] then begin ! 2984: Key := v2[I]; ! 2985: Break; ! 2986: end; ! 2987: end; ! 2988: FFlagCirconflexe := FALSE; ! 2989: end; ! 2990: if (FFlagTrema) then begin ! 2991: for I := Length(v1) downto 1 do begin ! 2992: if Key = v1[I] then begin ! 2993: Key := v3[I]; ! 2994: Break; ! 2995: end; ! 2996: end; ! 2997: FFlagTrema := FALSE; ! 2998: end; ! 2999: Handled := TRUE; ! 3000: end; ! 3001: end; ! 3002: ! 3003: { DebugString('Char = ' + IntToHex(Integer(Key), 2) + #13 + #10); } ! 3004: if Handled and (Key <> #0) then ! 3005: KeyPress(Key); ! 3006: end; ! 3007: ! 3008: if not Handled and Assigned(FAppOnMessage) then ! 3009: FAppOnMessage(Msg, Handled); ! 3010: end; ! 3011: ! 3012: ! 3013: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3014: procedure TCustomEmulVT.KeyPress(var Key: Char); ! 3015: begin ! 3016: if not FScreen.FNoXlat then ! 3017: Key := FScreen.FXlatOutputTable^[ord(Key)]; ! 3018: ! 3019: inherited KeyPress(Key); ! 3020: if FLocalEcho then begin ! 3021: WriteChar(Key); ! 3022: if not FAutoRepaint then ! 3023: UpdateScreen; ! 3024: end; ! 3025: end; ! 3026: ! 3027: ! 3028: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3029: procedure TCustomEmulVT.WMSetFocus(var Message: TWMSetFocus); ! 3030: begin ! 3031: { inherited; } ! 3032: FScreen.Focused := TRUE; ! 3033: { SetupFont; } ! 3034: ! 3035: if not FCursorVisible then ! 3036: Exit; ! 3037: ! 3038: CreateCaret(Handle, 0, 2, FLineHeight); ! 3039: FCaretCreated := TRUE; ! 3040: SetCaret; ! 3041: if not FScreen.FCursorOff then begin ! 3042: ShowCaret(Handle); ! 3043: FCaretShown := TRUE; ! 3044: end; ! 3045: ! 3046: FAppOnMessage := Application.OnMessage; ! 3047: Application.OnMessage := AppMessageHandler; ! 3048: end; ! 3049: ! 3050: ! 3051: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3052: procedure TCustomEmulVT.WMKillFocus(var Message: TWMKillFocus); ! 3053: begin ! 3054: { inherited; } ! 3055: FScreen.Focused := FALSE; ! 3056: ! 3057: if not FCursorVisible then ! 3058: Exit; ! 3059: ! 3060: if FCaretShown then begin ! 3061: HideCaret(Handle); ! 3062: FCaretShown := FALSE; ! 3063: end; ! 3064: ! 3065: if FCaretCreated then begin ! 3066: DestroyCaret; ! 3067: FCaretCreated := FALSE; ! 3068: end; ! 3069: ! 3070: Application.OnMessage := FAppOnMessage; ! 3071: end; ! 3072: ! 3073: ! 3074: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3075: procedure TCustomEmulVT.MouseToCell(X, Y: Integer; var ACol, ARow: Longint); ! 3076: begin ! 3077: {$IFDEF CHAR_ZOOM} ! 3078: aRow := FScreen.FRowCount - 1; ! 3079: while (Y - TopMargin) <= FLinePos[aRow] do ! 3080: Dec(aRow); ! 3081: {$ELSE} ! 3082: aRow := (Y - TopMargin) div FLineHeight; ! 3083: {$ENDIF} ! 3084: if aRow < 0 then ! 3085: aRow := 0 ! 3086: else if aRow >= FScreen.FRowCount then ! 3087: aRow := FScreen.FRowCount - 1; ! 3088: ! 3089: {$IFDEF CHAR_ZOOM} ! 3090: aCol := FScreen.FColCount - 1; ! 3091: while (X - LeftMargin) <= FCharPos[aCol] do ! 3092: Dec(aCol); ! 3093: {$ELSE} ! 3094: aCol := (X - LeftMargin) div FCharWidth; ! 3095: {$ENDIF} ! 3096: if aCol < 0 then ! 3097: aCol := 0 ! 3098: else if aCol >= FScreen.FColCount then ! 3099: aCol := FScreen.FColCount - 1; ! 3100: end; ! 3101: ! 3102: ! 3103: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3104: procedure TCustomEmulVT.ShowCursor; ! 3105: begin ! 3106: SetCaret; ! 3107: end; ! 3108: ! 3109: ! 3110: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3111: procedure TCustomEmulVT.WMPaletteChanged(var Message : TMessage); ! 3112: {var ! 3113: HandleDC : HDC;} ! 3114: begin ! 3115: { if Message.wParam <> Handle then begin ! 3116: HandleDC := GetDC(Handle); ! 3117: SelectPalette(HandleDC, FPal, FALSE); ! 3118: if RealizePalette(HandleDC) <> 0 then begin ! 3119: InvalidateRect(Handle, nil, TRUE); ! 3120: MessageBeep(0); ! 3121: end; ! 3122: ReleaseDC(Handle, HandleDC); ! 3123: end; ! 3124: } ! 3125: end; ! 3126: ! 3127: ! 3128: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3129: procedure TCustomEmulVT.UpdateScreen; ! 3130: var ! 3131: rc : TRect; ! 3132: begin ! 3133: if FScreen.FAllInvalid then ! 3134: InvalidateRect(Handle, nil, FALSE) ! 3135: else begin ! 3136: {$Q-} ! 3137: with FScreen.FInvRect do begin ! 3138: {$IFDEF CHAR_ZOOM} ! 3139: if Left = 9999 then begin ! 3140: rc.Top := 0; ! 3141: rc.Bottom := 0; ! 3142: rc.Left := 0; ! 3143: rc.Right := 0; ! 3144: end ! 3145: else begin ! 3146: rc.Top := TopMargin + FLinePos[Top - FTopLine] + FInternalLeading; ! 3147: rc.Bottom := TopMargin + FLinePos[Bottom + 1 - FTopLine] + FInternalLeading; ! 3148: rc.Left := LeftMargin + FCharPos[Left]; ! 3149: rc.Right := LeftMargin + FCharPos[Right + 1]; ! 3150: end; ! 3151: {$ELSE} ! 3152: rc.Top := TopMargin + FLineHeight * (Top - FTopLine) + FInternalLeading; ! 3153: rc.Bottom := TopMargin + FLineHeight * (Bottom + 1 - FTopLine) + FInternalLeading; ! 3154: rc.Left := LeftMargin + FCharWidth * Left; ! 3155: rc.Right := LeftMargin + FCharWidth * (Right + 1); ! 3156: {$ENDIF} ! 3157: end; ! 3158: InvalidateRect(Handle, @rc, FALSE); ! 3159: {$Q+} ! 3160: end; ! 3161: ! 3162: { Invalidate the region where the caret is. I should'nt do that, but } ! 3163: { if I do'nt, the caret remains where it is ! Bug ? } ! 3164: {$IFDEF CHAR_ZOOM} ! 3165: rc.Top := FLinePos[FScreen.FRow - FTopLine] + TopMargin; ! 3166: rc.Bottom := FLinePos[FScreen.FRow - FTopLine + 1] + TopMargin; ! 3167: rc.Left := LeftMargin + FCharPos[FScreen.FCol]; ! 3168: rc.Right := LeftMargin + FCharPos[FScreen.FCol + 1]; ! 3169: {$ELSE} ! 3170: rc.Top := TopMargin + FLineHeight * (FScreen.FRow - FTopLine); ! 3171: rc.Bottom := rc.Top + FLineHeight; ! 3172: rc.Left := LeftMargin + FCharWidth * FScreen.FCol; ! 3173: rc.Right := rc.Left + FCharWidth; ! 3174: {$ENDIF} ! 3175: InvalidateRect(Handle, @rc, FALSE); ! 3176: ! 3177: FScreen.InvClear; ! 3178: ! 3179: if FCaretCreated then begin ! 3180: ShowCaret(Handle); ! 3181: FCaretShown := TRUE; ! 3182: end; ! 3183: SetCaret; ! 3184: end; ! 3185: ! 3186: ! 3187: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3188: function TCustomEmulVT.SnapPixelToRow(Y : Integer) : Integer; ! 3189: var ! 3190: nRow : Integer; ! 3191: begin ! 3192: nRow := PixelToRow(Y); ! 3193: {$IFDEF CHAR_ZOOM} ! 3194: Result := TopMargin + FLinePos[nRow]; ! 3195: {$ELSE} ! 3196: Result := TopMargin + nRow * FLineHeight; ! 3197: {$ENDIF} ! 3198: end; ! 3199: ! 3200: ! 3201: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3202: function TCustomEmulVT.SnapPixelToCol(X : Integer) : Integer; ! 3203: var ! 3204: nCol : Integer; ! 3205: begin ! 3206: nCol := PixelToCol(X); ! 3207: {$IFDEF CHAR_ZOOM} ! 3208: Result := LeftMargin + FCharPos[nCol]; ! 3209: {$ELSE} ! 3210: Result := LeftMargin + nCol * FCharWidth; ! 3211: {$ENDIF} ! 3212: end; ! 3213: ! 3214: ! 3215: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3216: function TCustomEmulVT.PixelToRow(Y : Integer) : Integer; ! 3217: var ! 3218: nRow : Integer; ! 3219: begin ! 3220: {$IFDEF CHAR_ZOOM} ! 3221: nRow := FScreen.FRowCount - 1; ! 3222: while (nRow > 0) and ((Y - TopMargin) < FLinePos[nRow]) do ! 3223: Dec(nRow); ! 3224: {$ELSE} ! 3225: nRow := (Y - TopMargin) div FLineHeight; ! 3226: {$ENDIF} ! 3227: if nRow < 0 then ! 3228: nRow := 0; ! 3229: Result := nRow; ! 3230: end; ! 3231: ! 3232: ! 3233: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3234: function TCustomEmulVT.PixelToCol(X : Integer) : Integer; ! 3235: var ! 3236: nCol : Integer; ! 3237: begin ! 3238: {$IFDEF CHAR_ZOOM} ! 3239: nCol := FScreen.FColCount - 1; ! 3240: while (X - LeftMargin) < FCharPos[nCol] do ! 3241: Dec(nCol); ! 3242: {$ELSE} ! 3243: nCol := (X - LeftMargin) div FCharWidth; ! 3244: {$ENDIF} ! 3245: if nCol < 0 then ! 3246: nCol := 0; ! 3247: Result := nCol; ! 3248: end; ! 3249: ! 3250: ! 3251: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3252: { This procedure will paint graphic char from the OEM charset (lines, } ! 3253: { corners, T and other like) using GDI functions. This will result in } ! 3254: { autosized characters, necessary for example to draw a frame when zoom } ! 3255: { affect character and line spacing. } ! 3256: procedure TCustomEmulVT.PaintGraphicChar( ! 3257: DC : HDC; ! 3258: X, Y : Integer; ! 3259: rc : PRect; ! 3260: ch : Char); ! 3261: const ! 3262: OneSpace : Char = ' '; ! 3263: var ! 3264: X1, X2, X3 : Integer; ! 3265: Y1, Y2, Y3 : Integer; ! 3266: Co : TColor; ! 3267: begin ! 3268: ExtTextOut(DC, ! 3269: X, Y, ! 3270: ETO_OPAQUE or ETO_CLIPPED, rc, ! 3271: @OneSpace, 1, nil); ! 3272: X1 := X; ! 3273: X3 := rc^.Right; ! 3274: X2 := (X1 + X3) div 2; ! 3275: Y1 := rc^.Top; ! 3276: Y3 := rc^.Bottom; ! 3277: Y2 := (Y1 + Y3) div 2; ! 3278: case Ch of ! 3279: #$C4: begin { Horizontal single line } ! 3280: Canvas.MoveTo(X1, Y2); ! 3281: Canvas.LineTo(X3, Y2); ! 3282: end; ! 3283: #$B3: begin { Vertical single line } ! 3284: Canvas.MoveTo(X2, Y1); ! 3285: Canvas.LineTo(X2, Y3); ! 3286: end; ! 3287: #$DA: begin { Upper Left Single Corner } ! 3288: Canvas.MoveTo(X3, Y2); ! 3289: Canvas.LineTo(X2, Y2); ! 3290: Canvas.LineTo(X2, Y3); ! 3291: end; ! 3292: #$C0: begin { Bottom Left Single Corner } ! 3293: Canvas.MoveTo(X2, Y1); ! 3294: Canvas.LineTo(X2, Y2); ! 3295: Canvas.LineTo(X3, Y2); ! 3296: end; ! 3297: #$C1: begin { Reverse T } ! 3298: Canvas.MoveTo(X2, Y1); ! 3299: Canvas.LineTo(X2, Y2); ! 3300: Canvas.MoveTo(X1, Y2); ! 3301: Canvas.LineTo(X3, Y2); ! 3302: end; ! 3303: #$C2: begin { T } ! 3304: Canvas.MoveTo(X2, Y3); ! 3305: Canvas.LineTo(X2, Y2); ! 3306: Canvas.MoveTo(X1, Y2); ! 3307: Canvas.LineTo(X3, Y2); ! 3308: end; ! 3309: #$C3: begin { Left T } ! 3310: Canvas.MoveTo(X2, Y1); ! 3311: Canvas.LineTo(X2, Y3); ! 3312: Canvas.MoveTo(X2, Y2); ! 3313: Canvas.LineTo(X3, Y2); ! 3314: end; ! 3315: #$B4: begin { Right T } ! 3316: Canvas.MoveTo(X2, Y1); ! 3317: Canvas.LineTo(X2, Y3); ! 3318: Canvas.MoveTo(X2, Y2); ! 3319: Canvas.LineTo(X1 - 1, Y2); ! 3320: end; ! 3321: #$BF: begin { Top Right Single Corner } ! 3322: Canvas.MoveTo(X1, Y2); ! 3323: Canvas.LineTo(X2, Y2); ! 3324: Canvas.LineTo(X2, Y3); ! 3325: end; ! 3326: #$D9: begin { Bottom Right Single Corner } ! 3327: Canvas.MoveTo(X1, Y2); ! 3328: Canvas.LineTo(X2, Y2); ! 3329: Canvas.LineTo(X2, Y1 - 1); ! 3330: end; ! 3331: #$D6: begin { Upper Left Single/Double Corner } ! 3332: Canvas.MoveTo(X3, Y2); ! 3333: Canvas.LineTo(X2 - 1, Y2); ! 3334: Canvas.LineTo(X2 - 1, Y3); ! 3335: Canvas.MoveTo(X2 + 1, Y2); ! 3336: Canvas.LineTo(X2 + 1, Y3); ! 3337: end; ! 3338: #$D3: begin { Bottom Left Single/Double Corner } ! 3339: Canvas.MoveTo(X2 - 1, Y1); ! 3340: Canvas.LineTo(X2 - 1, Y2); ! 3341: Canvas.LineTo(X3, Y2); ! 3342: Canvas.MoveTo(X2 + 1, Y1); ! 3343: Canvas.LineTo(X2 + 1, Y2); ! 3344: end; ! 3345: #$B7: begin { Top Right Single/Double Corner } ! 3346: Canvas.MoveTo(X1, Y2); ! 3347: Canvas.LineTo(X2 + 1, Y2); ! 3348: Canvas.LineTo(X2 + 1, Y3); ! 3349: Canvas.MoveTo(X2 - 1, Y2); ! 3350: Canvas.LineTo(X2 - 1, Y3); ! 3351: end; ! 3352: #$BD: begin { Bottom Right Single/Double Corner } ! 3353: Canvas.MoveTo(X2 + 1, Y1); ! 3354: Canvas.LineTo(X2 + 1, Y2); ! 3355: Canvas.LineTo(X1 - 1, Y2); ! 3356: Canvas.MoveTo(X2 - 1, Y1); ! 3357: Canvas.LineTo(X2 - 1, Y2); ! 3358: end; ! 3359: #$D5: begin { Upper Left Double/Single Corner } ! 3360: Canvas.MoveTo(X3, Y2 - 1); ! 3361: Canvas.LineTo(X2, Y2 - 1); ! 3362: Canvas.LineTo(X2, Y3); ! 3363: Canvas.MoveTo(X3, Y2 + 1); ! 3364: Canvas.LineTo(X2, Y2 + 1); ! 3365: end; ! 3366: #$D4: begin { Bottom Left Double/Single Corner } ! 3367: Canvas.MoveTo(X2, Y1); ! 3368: Canvas.LineTo(X2, Y2 + 1); ! 3369: Canvas.LineTo(X3, Y2 + 1); ! 3370: Canvas.MoveTo(X2, Y2 - 1); ! 3371: Canvas.LineTo(X3, Y2 - 1); ! 3372: end; ! 3373: #$B8: begin { Top Right Double/Single Corner } ! 3374: Canvas.MoveTo(X1, Y2 - 1); ! 3375: Canvas.LineTo(X2, Y2 - 1); ! 3376: Canvas.LineTo(X2, Y3); ! 3377: Canvas.MoveTo(X1, Y2 + 1); ! 3378: Canvas.LineTo(X2, Y2 + 1); ! 3379: end; ! 3380: #$BE: begin { Bottom Right Double/Single Corner } ! 3381: Canvas.MoveTo(X2, Y1); ! 3382: Canvas.LineTo(X2, Y2 + 1); ! 3383: Canvas.LineTo(X1 - 1, Y2 + 1); ! 3384: Canvas.MoveTo(X1, Y2 - 1); ! 3385: Canvas.LineTo(X2, Y2 - 1); ! 3386: end; ! 3387: #$CD: begin { Horizontal Double line } ! 3388: Canvas.MoveTo(X1, Y2 + 1); ! 3389: Canvas.LineTo(X3, Y2 + 1); ! 3390: Canvas.MoveTo(X1, Y2 - 1); ! 3391: Canvas.LineTo(X3, Y2 - 1); ! 3392: end; ! 3393: #$BA: begin { Vertical Double line } ! 3394: Canvas.MoveTo(X2 + 1, Y1); ! 3395: Canvas.LineTo(X2 + 1, Y3); ! 3396: Canvas.MoveTo(X2 - 1, Y1); ! 3397: Canvas.LineTo(X2 - 1, Y3); ! 3398: end; ! 3399: #$D1: begin { T Top Horizontal Double line } ! 3400: Canvas.MoveTo(X1, Y2 + 1); ! 3401: Canvas.LineTo(X3, Y2 + 1); ! 3402: Canvas.MoveTo(X1, Y2 - 1); ! 3403: Canvas.LineTo(X3, Y2 - 1); ! 3404: Canvas.MoveTo(X2, Y2 + 1); ! 3405: Canvas.LineTo(X2, Y3); ! 3406: end; ! 3407: #$CF: begin { T Bottom Horizontal Double line } ! 3408: Canvas.MoveTo(X1, Y2 + 1); ! 3409: Canvas.LineTo(X3, Y2 + 1); ! 3410: Canvas.MoveTo(X1, Y2 - 1); ! 3411: Canvas.LineTo(X3, Y2 - 1); ! 3412: Canvas.MoveTo(X2, Y2 - 1); ! 3413: Canvas.LineTo(X2, Y1); ! 3414: end; ! 3415: #$C6: begin { T Left Horizontal Double line } ! 3416: Canvas.MoveTo(X2, Y2 + 1); ! 3417: Canvas.LineTo(X3, Y2 + 1); ! 3418: Canvas.MoveTo(X2, Y2 - 1); ! 3419: Canvas.LineTo(X3, Y2 - 1); ! 3420: Canvas.MoveTo(X2, Y1); ! 3421: Canvas.LineTo(X2, Y3); ! 3422: end; ! 3423: #$B5: begin { T Right Horizontal Double line } ! 3424: Canvas.MoveTo(X1, Y2 + 1); ! 3425: Canvas.LineTo(X2, Y2 + 1); ! 3426: Canvas.MoveTo(X1, Y2 - 1); ! 3427: Canvas.LineTo(X2, Y2 - 1); ! 3428: Canvas.MoveTo(X2, Y1); ! 3429: Canvas.LineTo(X2, Y3); ! 3430: end; ! 3431: #$C9: begin { Upper Left Double Corner } ! 3432: Canvas.MoveTo(X3, Y2 - 1); ! 3433: Canvas.LineTo(X2 - 1, Y2 - 1); ! 3434: Canvas.LineTo(X2 - 1, Y3); ! 3435: Canvas.MoveTo(X3, Y2 + 1); ! 3436: Canvas.LineTo(X2 + 1, Y2 + 1); ! 3437: Canvas.LineTo(X2 + 1, Y3); ! 3438: end; ! 3439: #$C8: begin { Bottom Left Double Corner } ! 3440: Canvas.MoveTo(X2 - 1, Y1); ! 3441: Canvas.LineTo(X2 - 1, Y2 + 1); ! 3442: Canvas.LineTo(X3, Y2 + 1); ! 3443: Canvas.MoveTo(X2 + 1, Y1); ! 3444: Canvas.LineTo(X2 + 1, Y2 - 1); ! 3445: Canvas.LineTo(X3, Y2 - 1); ! 3446: end; ! 3447: #$BB: begin { Top Right Double Corner } ! 3448: Canvas.MoveTo(X1, Y2 - 1); ! 3449: Canvas.LineTo(X2 + 1, Y2 - 1); ! 3450: Canvas.LineTo(X2 + 1, Y3); ! 3451: Canvas.MoveTo(X1, Y2 + 1); ! 3452: Canvas.LineTo(X2 - 1, Y2 + 1); ! 3453: Canvas.LineTo(X2 - 1, Y3); ! 3454: end; ! 3455: #$BC: begin { Bottom Right Double Corner } ! 3456: Canvas.MoveTo(X2 - 1, Y1); ! 3457: Canvas.LineTo(X2 - 1, Y2 - 1); ! 3458: Canvas.LineTo(X1 - 1, Y2 - 1); ! 3459: Canvas.MoveTo(X2 + 1, Y1); ! 3460: Canvas.LineTo(X2 + 1, Y2 + 1); ! 3461: Canvas.LineTo(X1 - 1, Y2 + 1); ! 3462: end; ! 3463: #$CC: begin { Double left T } ! 3464: Canvas.MoveTo(X2 - 1, Y1); ! 3465: Canvas.LineTo(X2 - 1, Y3); ! 3466: Canvas.MoveTo(X2 + 1, Y1); ! 3467: Canvas.LineTo(X2 + 1, Y2 - 1); ! 3468: Canvas.LineTo(X3, Y2 - 1); ! 3469: Canvas.MoveTo(X3, Y2 + 1); ! 3470: Canvas.LineTo(X2 + 1, Y2 + 1); ! 3471: Canvas.LineTo(X2 + 1, Y3); ! 3472: end; ! 3473: #$B9: begin { Double Right T } ! 3474: Canvas.MoveTo(X2 + 1, Y1); ! 3475: Canvas.LineTo(X2 + 1, Y3); ! 3476: Canvas.MoveTo(X2 - 1, Y1); ! 3477: Canvas.LineTo(X2 - 1, Y2 - 1); ! 3478: Canvas.LineTo(X1 - 1, Y2 - 1); ! 3479: Canvas.MoveTo(X1, Y2 + 1); ! 3480: Canvas.LineTo(X2 - 1, Y2 + 1); ! 3481: Canvas.LineTo(X2 - 1, Y3); ! 3482: end; ! 3483: #$C7: begin { Double T Single Left } ! 3484: Canvas.MoveTo(X2 + 1, Y1); ! 3485: Canvas.LineTo(X2 + 1, Y3); ! 3486: Canvas.MoveTo(X2 - 1, Y1); ! 3487: Canvas.LineTo(X2 - 1, Y3); ! 3488: Canvas.MoveTo(X2 + 1, Y2); ! 3489: Canvas.LineTo(X3, Y2); ! 3490: end; ! 3491: #$B6: begin { Double T Single Right } ! 3492: Canvas.MoveTo(X2 + 1, Y1); ! 3493: Canvas.LineTo(X2 + 1, Y3); ! 3494: Canvas.MoveTo(X2 - 1, Y1); ! 3495: Canvas.LineTo(X2 - 1, Y3); ! 3496: Canvas.MoveTo(X2 - 1, Y2); ! 3497: Canvas.LineTo(X1 - 1, Y2); ! 3498: end; ! 3499: #$D2: begin { Single T Double Top } ! 3500: Canvas.MoveTo(X1, Y2); ! 3501: Canvas.LineTo(X3, Y2); ! 3502: Canvas.MoveTo(X2 - 1, Y2); ! 3503: Canvas.LineTo(X2 - 1, Y3); ! 3504: Canvas.MoveTo(X2 + 1, Y2); ! 3505: Canvas.LineTo(X2 + 1, Y3); ! 3506: end; ! 3507: #$D0: begin { Single T Double Bottom } ! 3508: Canvas.MoveTo(X1, Y2); ! 3509: Canvas.LineTo(X3, Y2); ! 3510: Canvas.MoveTo(X2 - 1, Y2); ! 3511: Canvas.LineTo(X2 - 1, Y1); ! 3512: Canvas.MoveTo(X2 + 1, Y2); ! 3513: Canvas.LineTo(X2 + 1, Y1); ! 3514: end; ! 3515: #$DB: begin { Full Block } ! 3516: Canvas.Rectangle(X1, Y1, X3, Y3); ! 3517: end; ! 3518: #$DC: begin { Half Bottom Block } ! 3519: Canvas.Rectangle(X1, Y2, X3, Y3); ! 3520: end; ! 3521: #$DD: begin { Half Left Block } ! 3522: Canvas.Rectangle(X1, Y1, X2, Y3); ! 3523: end; ! 3524: #$DE: begin { Half Right Block } ! 3525: Canvas.Rectangle(X2, Y1, X3, Y3); ! 3526: end; ! 3527: #$DF: begin { Half Top Block } ! 3528: Canvas.Rectangle(X1, Y1, X2, Y2); ! 3529: end; ! 3530: #$C5: begin { Single Cross } ! 3531: Canvas.MoveTo(X1, Y2); ! 3532: Canvas.LineTo(X3, Y2); ! 3533: Canvas.MoveTo(X2, Y1); ! 3534: Canvas.LineTo(X2, Y3); ! 3535: end; ! 3536: #$CE: begin { Double Cross } ! 3537: Canvas.MoveTo(X1, Y2 - 1); ! 3538: Canvas.LineTo(X2 - 1, Y2 - 1); ! 3539: Canvas.LineTo(X2 - 1, Y1); ! 3540: Canvas.MoveTo(X1, Y2 + 1); ! 3541: Canvas.LineTo(X2 - 1, Y2 + 1); ! 3542: Canvas.LineTo(X2 - 1, Y3); ! 3543: Canvas.MoveTo(X2 + 1, Y1); ! 3544: Canvas.LineTo(X2 + 1, Y2 - 1); ! 3545: Canvas.LineTo(X3, Y2 - 1); ! 3546: Canvas.MoveTo(X2 + 1, Y3); ! 3547: Canvas.LineTo(X2 + 1, Y2 + 1); ! 3548: Canvas.LineTo(X3, Y2 + 1); ! 3549: end; ! 3550: #$D8: begin { Cross Double Horizontal Single vertical } ! 3551: Canvas.MoveTo(X1, Y2 + 1); ! 3552: Canvas.LineTo(X3, Y2 + 1); ! 3553: Canvas.MoveTo(X1, Y2 - 1); ! 3554: Canvas.LineTo(X3, Y2 - 1); ! 3555: Canvas.MoveTo(X2, Y1); ! 3556: Canvas.LineTo(X2, Y3); ! 3557: end; ! 3558: #$D7: begin { Cross Single Horizontal Double Vertical } ! 3559: Canvas.MoveTo(X2 + 1, Y1); ! 3560: Canvas.LineTo(X2 + 1, Y3); ! 3561: Canvas.MoveTo(X2 - 1, Y1); ! 3562: Canvas.LineTo(X2 - 1, Y3); ! 3563: Canvas.MoveTo(X1, Y2); ! 3564: Canvas.LineTo(X3, Y2); ! 3565: end; ! 3566: #$CA: begin { Double T bottom } ! 3567: Canvas.MoveTo(X1, Y2 - 1); ! 3568: Canvas.LineTo(X2 - 1, Y2 - 1); ! 3569: Canvas.LineTo(X2 - 1, Y1); ! 3570: Canvas.MoveTo(X2 + 1, Y1); ! 3571: Canvas.LineTo(X2 + 1, Y2 - 1); ! 3572: Canvas.LineTo(X3, Y2 - 1); ! 3573: Canvas.MoveTo(X1, Y2 + 1); ! 3574: Canvas.LineTo(X3, Y2 + 1); ! 3575: end; ! 3576: #$CB: begin { Double T } ! 3577: Canvas.MoveTo(X1, Y2 + 1); ! 3578: Canvas.LineTo(X2 - 1, Y2 + 1); ! 3579: Canvas.LineTo(X2 - 1, Y3); ! 3580: Canvas.MoveTo(X2 + 1, Y3); ! 3581: Canvas.LineTo(X2 + 1, Y2 + 1); ! 3582: Canvas.LineTo(X3, Y2 + 1); ! 3583: Canvas.MoveTo(X1, Y2 - 1); ! 3584: Canvas.LineTo(X3, Y2 - 1); ! 3585: end; ! 3586: #$B0: begin ! 3587: Co := Canvas.Pen.Color; ! 3588: for Y := Y1 to Y3 do begin ! 3589: X := X1 + (Y mod 3); ! 3590: while X < X3 do begin ! 3591: Canvas.Pixels[X, Y] := Co; ! 3592: X := X + 3; ! 3593: end; ! 3594: end; ! 3595: end; ! 3596: #$B1: begin ! 3597: Co := Canvas.Pen.Color; ! 3598: for Y := Y1 to Y3 do begin ! 3599: X := X1 + (Y and 1); ! 3600: while X < X3 do begin ! 3601: Canvas.Pixels[X, Y] := Co; ! 3602: X := X + 2; ! 3603: end; ! 3604: end; ! 3605: end; ! 3606: #$B2: begin ! 3607: Co := Canvas.Pen.Color; ! 3608: for Y := Y1 to Y3 do begin ! 3609: X := X1 + (Y mod 3); ! 3610: while X < X3 do begin ! 3611: Canvas.Pixels[X, Y] := Co; ! 3612: Inc(X); ! 3613: if X < X3 then ! 3614: Canvas.Pixels[X, Y] := Co; ! 3615: Inc(X); ! 3616: Inc(X); ! 3617: end; ! 3618: end; ! 3619: end; ! 3620: end; ! 3621: end; ! 3622: ! 3623: ! 3624: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3625: procedure TCustomEmulVT.PaintOneLine( ! 3626: DC : HDC; ! 3627: Y, Y1 : Integer; ! 3628: const Line : TLine; ! 3629: nColFrom : Integer; ! 3630: nColTo : Integer); ! 3631: var ! 3632: rc : TRect; ! 3633: nCnt : Integer; ! 3634: nAtt : Byte; ! 3635: X : Integer; ! 3636: nChr : Integer; ! 3637: Ch : Char; ! 3638: begin ! 3639: nAtt := Line.Att[nColFrom]; ! 3640: ! 3641: { if nAtt = $0B then ! 3642: X := 0; } ! 3643: { ! 3644: SetBkColor(DC, PALETTEINDEX(nAtt div $0F)); ! 3645: SetTextColor(DC, PALETTEINDEX(nAtt and $0F)); ! 3646: } ! 3647: if not FMonoChrome then begin ! 3648: with FPaletteEntries[(nAtt shr 4) and $0F] do ! 3649: SetBkColor(DC, PALETTERGB(peRed, peGreen, peBlue)); ! 3650: with FPaletteEntries[nAtt and $0F] do begin ! 3651: SetTextColor(DC, PALETTERGB(peRed, peGreen, peBlue)); ! 3652: Canvas.Pen.Color := PALETTERGB(peRed, peGreen, peBlue); ! 3653: Canvas.Brush.Color := PALETTERGB(peRed, peGreen, peBlue); ! 3654: end; ! 3655: end ! 3656: else begin ! 3657: if (nAtt div $0F) <> 0 then ! 3658: SetBkColor(DC, RGB(127, 127, 127)) ! 3659: else ! 3660: SetBkColor(DC, RGB(255, 255, 255)); ! 3661: ! 3662: if (nAtt and $0F) <> 0 then ! 3663: SetTextColor(DC, RGB(0, 0, 0)) ! 3664: else ! 3665: SetTextColor(DC, RGB(255, 255, 255)); ! 3666: end; ! 3667: ! 3668: nCnt := nColTo - nColFrom; ! 3669: nChr := 0; ! 3670: {$IFDEF SINGLE_CHAR_PAINT} ! 3671: while nChr < nCnt do begin ! 3672: {$IFDEF CHAR_ZOOM} ! 3673: X := LeftMargin + FCharPos[nColFrom + nChr]; ! 3674: rc.Top := Y + FInternalLeading; ! 3675: rc.Bottom := Y1 + FInternalLeading; ! 3676: rc.Left := X; ! 3677: rc.Right := LeftMargin + FCharPos[nColFrom + nChr + 1]; ! 3678: {$ELSE} ! 3679: X := LeftMargin + (nColFrom + nChr) * FCharWidth; ! 3680: rc.Top := Y + FInternalLeading; ! 3681: rc.Bottom := Y1 + FInternalLeading; ! 3682: rc.Left := X; ! 3683: rc.Right := rc.Left + FCharWidth; ! 3684: {$ENDIF} ! 3685: if (nColFrom + nChr) = 0 then ! 3686: rc.Left := rc.Left - LeftMargin; ! 3687: if (nColFrom + nChr) >= FScreen.FColCount then ! 3688: rc.Right := rc.Right + RightMargin; ! 3689: Ch := Line.Txt[nColFrom + nChr]; ! 3690: if FGraphicDraw and ! 3691: (FScreen.FXlatOutputTable = @ibm_iso8859_1_G0) and ! 3692: (Ch >= #$B0) and (Ch <= #$DF) and ! 3693: (Ch in [#$B3, #$C4, #$DA, #$C0, #$C1, #$C2, #$C3, #$B4, #$BF, #$D9, ! 3694: #$DB, #$DC, #$DD, #$DE, #$DF, ! 3695: #$BA, #$CD, #$C9, #$C8, #$BB, #$BC, ! 3696: #$CC, #$B9, #$C7, #$B6, #$D2, #$D0, ! 3697: #$D5, #$D4, #$B8, #$BE, ! 3698: #$C6, #$D1, #$B5, #$CF, ! 3699: #$D6, #$B7, #$D3, #$BD, ! 3700: #$C5, #$CE, #$D8, #$D7, #$CA, #$CB, ! 3701: #$B0, #$B1, #$B2]) then ! 3702: PaintGraphicChar(DC, X, Y, @rc, Ch) ! 3703: else ! 3704: ExtTextOut(DC, X, Y, ETO_OPAQUE or ETO_CLIPPED, @rc, @Ch, 1, nil); ! 3705: Inc(nChr); ! 3706: end; ! 3707: {$ELSE} ! 3708: {$IFDEF CHAR_ZOOM} ! 3709: X := LeftMargin + FCharPos[nColFrom]; ! 3710: rc.Top := Y + FInternalLeading; ! 3711: rc.Bottom := Y1 + FInternalLeading; ! 3712: rc.Left := X; ! 3713: rc.Right := LeftMargin + FCharPos[nColFrom + nCnt]; ! 3714: {$ELSE} ! 3715: X := LeftMargin + nColFrom * FCharWidth; ! 3716: rc.Top := Y + FInternalLeading; ! 3717: rc.Bottom := Y1 + FInternalLeading; ! 3718: rc.Left := X; ! 3719: rc.Right := rc.Left + nCnt * FCharWidth; ! 3720: {$ENDIF} ! 3721: if nColFrom = 0 then ! 3722: rc.Left := rc.Left - LeftMargin; ! 3723: if nColTo >= FScreen.FColCount then ! 3724: rc.Right := rc.Right + RightMargin; ! 3725: ExtTextOut(DC, ! 3726: X, Y, ! 3727: ETO_OPAQUE or ETO_CLIPPED, @rc, ! 3728: @Line.Txt[nColFrom], nCnt, nil); ! 3729: {$ENDIF} ! 3730: end; ! 3731: ! 3732: ! 3733: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3734: procedure TCustomEmulVT.WMPaint(var Message: TWMPaint); ! 3735: var ! 3736: DC : HDC; ! 3737: PS : TPaintStruct; ! 3738: Y, Y1 : Integer; ! 3739: rc : TRect; ! 3740: OldPen : THandle; ! 3741: OldBrush : THandle; ! 3742: OldFont : THandle; ! 3743: rcPaint : TRect; ! 3744: DrawRct : TRect; ! 3745: nRow : Integer; ! 3746: nCol : Integer; ! 3747: nColFrom : Integer; ! 3748: Line : TLine; ! 3749: BackBrush : HBrush; ! 3750: begin ! 3751: { This may be a bit of overkill but we have to keep the scrollbar tracking ! 3752: with the number of lines visible on the screen. The calling program can ! 3753: change the Height of the screen and we don't have a good way to know that. ! 3754: This routine will get called whenever the screen gets updated so it is a ! 3755: good time to update the scrollbar. } ! 3756: AdjustScrollBar; ! 3757: ! 3758: if not GetUpdateRect(WindowHandle, rc, FALSE) then ! 3759: Exit; ! 3760: ! 3761: BackBrush := 0; ! 3762: OldBrush := 0; ! 3763: ! 3764: DC := Message.DC; ! 3765: if DC = 0 then ! 3766: DC := BeginPaint(WindowHandle, PS); ! 3767: try ! 3768: if not FMonoChrome then begin ! 3769: SelectPalette(DC, FPal, FALSE); ! 3770: RealizePalette(DC); ! 3771: with FPaletteEntries[FScreen.FAttribute div $0F] do ! 3772: BackBrush := CreateSolidBrush(PALETTERGB(peRed, peGreen, peBlue)); ! 3773: OldBrush := SelectObject(DC, BackBrush); ! 3774: end; ! 3775: ! 3776: WinProcs.GetClientRect(WindowHandle, DrawRct); ! 3777: rcPaint := PS.rcPaint; ! 3778: rc.Left := 2; ! 3779: rc.Right := DrawRct.Right - 2; ! 3780: nRow := PixelToRow(rcPaint.top); ! 3781: nRow := nRow - 1; ! 3782: if nRow < 0 then ! 3783: nRow := 0; ! 3784: ! 3785: {$IFDEF CHAR_ZOOM} ! 3786: Y := TopMargin + FLinePos[nRow]; ! 3787: Y1 := TopMargin + FLinePos[nRow + 1]; ! 3788: {$ELSE} ! 3789: Y := TopMargin + nRow * FLineHeight; ! 3790: Y1 := Y + FLineHeight; ! 3791: {$ENDIF} ! 3792: ! 3793: if rcPaint.Top <= TopMargin then begin ! 3794: OldPen := SelectObject(DC, GetStockObject(NULL_PEN)); ! 3795: WinProcs.Rectangle(DC, rcPaint.left, rcPaint.Top, ! 3796: rcPaint.Right + 1, ! 3797: TopMargin + FInternalLeading + 1); ! 3798: SelectObject(DC, OldPen); ! 3799: end; ! 3800: ! 3801: if (nRow = 0) and (FInternalLeading > 0) then begin ! 3802: OldPen := SelectObject(DC, GetStockObject(NULL_PEN)); ! 3803: WinProcs.Rectangle(DC, rcPaint.left, rcPaint.Top, ! 3804: rcPaint.Right + 1, ! 3805: Y + FInternalLeading + 1); ! 3806: SelectObject(DC, OldPen); ! 3807: end; ! 3808: ! 3809: OldFont := SelectObject(DC, FFont.Handle); ! 3810: nRow := nRow + FTopLine; ! 3811: while nRow < FScreen.FRowCount do begin ! 3812: rc.Top := Y; ! 3813: rc.Bottom := Y + FLineHeight; ! 3814: if rc.Bottom > (DrawRct.Bottom - BottomMargin) then begin ! 3815: OldPen := SelectObject(DC, GetStockObject(NULL_PEN)); ! 3816: WinProcs.Rectangle(DC, rc.Left - 2, rc.Top, rc.Right + 1, ! 3817: DrawRct.Bottom - 1); ! 3818: SelectObject(DC, OldPen); ! 3819: Break; ! 3820: end; ! 3821: Line := FScreen.Lines[nRow]; ! 3822: ! 3823: nCol := 0; ! 3824: nColFrom := 0; ! 3825: while nCol < FScreen.FColCount do begin ! 3826: while (nCol < FScreen.FColCount) and ! 3827: (Line.Att[nCol] = Line.Att[nColFrom]) do ! 3828: Inc(nCol); ! 3829: ! 3830: PaintOneLine(DC, Y, Y1, Line, nColFrom, nCol); ! 3831: nColFrom := nCol; ! 3832: end; ! 3833: ! 3834: nRow := nRow + 1; ! 3835: {$IFDEF CHAR_ZOOM} ! 3836: Y := TopMargin + FLinePos[nRow - FTopLine]; ! 3837: Y1 := TopMargin + FLinePos[nRow + 1 - FTopLine]; ! 3838: {$ELSE} ! 3839: Y := Y + FLineHeight; ! 3840: Y1 := Y + FLineHeight; ! 3841: {$ENDIF} ! 3842: if Y > rcPaint.Bottom then ! 3843: Break; ! 3844: end; ! 3845: ! 3846: { Fill region between last text line and bottom of the window } ! 3847: OldPen := SelectObject(DC, GetStockObject(NULL_PEN)); ! 3848: if (FScreen.FRowCount - FTopLine) <= MAX_ROW then { WM + SE 09/08/00 } ! 3849: WinProcs.Rectangle(DC, rc.Left - 2, ! 3850: TopMargin + FLinePos[FScreen.FRowCount - FTopLine] + 1, ! 3851: rc.Right + 1, DrawRct.Bottom + 1); ! 3852: SelectObject(DC, OldPen); ! 3853: ! 3854: {$IFDEF CHAR_ZOOM} ! 3855: if (LeftMargin + FCharPos[FScreen.FColCount]) < rc.Right then begin ! 3856: OldPen := SelectObject(DC, GetStockObject(NULL_PEN)); ! 3857: WinProcs.Rectangle(DC, LeftMargin + FCharPos[FScreen.FColCount], ! 3858: TopMargin, { 09/03/99 } ! 3859: rcPaint.Right + 1, DrawRct.Bottom + 1); ! 3860: SelectObject(DC, OldPen); ! 3861: end; ! 3862: {$ELSE} ! 3863: if (LeftMargin + FScreen.FColCount * FCharWidth) < rc.Right then begin ! 3864: OldPen := SelectObject(DC, GetStockObject(NULL_PEN)); ! 3865: WinProcs.Rectangle(DC, LeftMargin + FScreen.FColCount * FCharWidth, ! 3866: TopMargin, rc.Right + 1, DrawRct.Bottom - 1); ! 3867: SelectObject(DC, OldPen); ! 3868: end; ! 3869: {$ENDIF} ! 3870: ! 3871: if FSelectRect.Top <> -1 then begin ! 3872: SelectObject(DC, GetStockObject(NULL_BRUSH)); ! 3873: SelectObject(DC, GetStockObject(BLACK_PEN)); ! 3874: WinProcs.Rectangle(DC, FSelectRect.Left, ! 3875: FSelectRect.Top, ! 3876: FSelectRect.Right + 1, ! 3877: FSelectRect.Bottom - 1); ! 3878: SelectObject(DC, GetStockObject(WHITE_PEN)); ! 3879: WinProcs.Rectangle(DC, FSelectRect.Left - 1, ! 3880: FSelectRect.Top - 1, ! 3881: FSelectRect.Right + 2, ! 3882: FSelectRect.Bottom); ! 3883: end; ! 3884: ! 3885: SelectObject(DC, OldFont); ! 3886: if OldBrush <> 0 then ! 3887: SelectObject(DC, OldBrush); ! 3888: if BackBrush <> 0 then ! 3889: DeleteObject(BackBrush); ! 3890: finally ! 3891: if Message.DC = 0 then ! 3892: EndPaint(WindowHandle, PS); ! 3893: end; ! 3894: end; ! 3895: ! 3896: ! 3897: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} ! 3898: ! 3899: end. ! 3900:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.