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