![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to emulvt.pas CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Synchronet] / sbbs / sbbs3 / ctrl|
Return to emulvt.pas CVS log | Up to [Synchronet] / sbbs / sbbs3 / ctrl |
1.1 root 1: {*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2:
3: Program: EMULVT.PAS
4: Description: Delphi component which does Ansi terminal emulation
5: Not every escape sequence is implemented, but a large subset.
6: Author: Fran�ois PIETTE
7: Creation: May, 1996
1.1.1.2 ! root 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
1.1 root 15: Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
1.1.1.2 ! root 16: <[email protected]><[email protected]>
1.1 root 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.
1.1.1.2 ! root 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:
1.1 root 77:
78: * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
1.1.1.2 ! root 79: unit EmulVT;
1.1 root 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
1.1.1.2 ! root 105: EmulVTVersion = 219;
! 106: CopyRight : String = ' TEmulVT (c) 1996-2002 F. Piette V2.19 ';
1.1 root 107: MAX_ROW = 50;
1.1.1.2 ! root 108: MAX_COL = 160;
1.1 root 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
1.1.1.2 ! root 264: FCharPos : array [0..MAX_COL + 1] of integer;
! 265: FLinePos : array [0..MAX_ROW + 1] of integer;
1.1 root 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;
1.1.1.2 ! root 292: FTopMargin : Integer;
! 293: FLeftMargin : Integer;
! 294: FRightMargin : Integer;
! 295: FBottomMargin : Integer;
1.1 root 296: FPal : HPalette;
297: FPaletteEntries : array[0..NumPaletteEntries - 1] of TPaletteEntry;
1.1.1.2 ! root 298: FMarginColor : Integer;
1.1 root 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);
1.1.1.2 ! root 314: procedure SetAutoWrap(Value : Boolean);
1.1 root 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;
1.1.1.2 ! root 326: function GetAutoWrap : Boolean;
1.1 root 327: function GetXlat : Boolean;
328: function GetRows : Integer;
329: function GetCols : Integer;
330: function GetBackRows : Integer;
331: function GetBackColor : TBackColors;
332: function GetOptions : TScreenOptions;
1.1.1.2 ! root 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);
1.1 root 338: protected
1.1.1.2 ! root 339: FScreen : TScreen;
1.1 root 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;
1.1.1.2 ! root 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;
1.1 root 372: property VScrollBar : TScrollBar read FVScrollBar;
1.1.1.2 ! root 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;
1.1 root 378: private
379: procedure PaintOneLine(DC: HDC; Y, Y1 : Integer; const Line : TLine;
1.1.1.2 ! root 380: nColFrom : Integer; nColTo : Integer; Blank : Boolean);
1.1 root 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;
1.1.1.2 ! root 400: property AutoWrap : Boolean read GetAutoWrap write SetAutoWrap;
1.1 root 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;
1.1.1.2 ! root 436: property AutoWrap;
1.1 root 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;
1.1.1.2 ! root 450: property TopMargin;
! 451: property LeftMargin;
! 452: property RightMargin;
! 453: property BottomMargin;
! 454: property MarginColor;
1.1 root 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:
1.1.1.2 ! root 1195: { Now, copy the host screen lines to the ones we made available. }
1.1 root 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
1.1.1.2 ! root 1528: NRow : Integer;
1.1 root 1529: begin
1530: Eol;
1.1.1.2 ! root 1531: for NRow := FRow + 1 to FRowCount - 1 do
! 1532: Lines[NRow].Clear(FAttribute);
1.1 root 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}
1.1.1.2 ! root 2300: SetCaretPos(FCharPos[FScreen.FCol] + FLeftMargin + 2,
! 2301: FLinePos[FScreen.FRow - FTopLine] + FTopMargin + 3);
1.1 root 2302: {$ELSE}
1.1.1.2 ! root 2303: SetCaretPos(FScreen.FCol * FCharWidth + FLeftMargin,
! 2304: (FScreen.FRow - FTopLine) * FLineHeight + FTopMargin);
1.1 root 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
1.1.1.2 ! root 2316: if not FVScrollBar.Visible then
! 2317: Exit;
1.1 root 2318: FVScrollBar.Min := FScreen.FBackEndRow;
2319: {$IFDEF CHAR_ZOOM}
1.1.1.2 ! root 2320: VisibleLines := Trunc((Height - FTopMargin - FBottomMargin) / (LineHeight * FLineZoom));
1.1 root 2321: {$ELSE}
1.1.1.2 ! root 2322: VisibleLines := (Height - FTopMargin - FBottomMargin) Div LineHeight;
1.1 root 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:
1.1.1.2 ! root 2443: FTopMargin := 4;
! 2444: FLeftMargin := 6;
! 2445: FRightMargin := 6;
! 2446: FBottomMargin := 4;
! 2447:
1.1 root 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;
1.1.1.2 ! root 2468: FPaletteEntries[6].peBlue := 112; { was 216 }
1.1 root 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;
1.1.1.2 ! root 2475: FPaletteEntries[9].peRed := 255; { Red Highlight }
! 2476: FPaletteEntries[9].peGreen := 0; { was 84 }
! 2477: FPaletteEntries[9].peBlue := 0; { was 212 }
1.1 root 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:
1.1.1.2 ! root 2620: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
! 2621: procedure TCustomEmulVT.SetAutoWrap(Value : Boolean);
! 2622: begin
! 2623: FScreen.FAutoWrap := Value;
! 2624: end;
1.1 root 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:
1.1.1.2 ! root 2678: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
! 2679: function TCustomEmulVT.GetAutoWrap : Boolean;
! 2680: begin
! 2681: Result := FScreen.FAutoWrap;
! 2682: end;
1.1 root 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;
1.1.1.2 ! root 2734: Invalidate;
1.1 root 2735: end;
2736:
2737:
2738: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
2739: function TCustomEmulVT.GetBackColor : TBackColors;
2740: begin
2741: Result := FScreen.FBackColor;
2742: end;
2743:
2744:
2745: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
1.1.1.2 ! root 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: {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
1.1 root 2786: procedure TCustomEmulVT.SetOptions(Value : TScreenOptions);
2787: begin
2788: FScreen.FOptions := Value;
1.1.1.2 ! root 2789: Invalidate;
1.1 root 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;
1.1.1.2 ! root 2816: Invalidate;
1.1 root 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;
1.1.1.2 ! root 2845: for nRow := 0 to High(FLinePos) do { Jan 10, 2002 }
1.1 root 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;
1.1.1.2 ! root 3168: while (Y - FTopMargin) <= FLinePos[aRow] do
1.1 root 3169: Dec(aRow);
3170: {$ELSE}
1.1.1.2 ! root 3171: aRow := (Y - FTopMargin) div FLineHeight;
1.1 root 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;
1.1.1.2 ! root 3180: while (X - FLeftMargin) <= FCharPos[aCol] do
1.1 root 3181: Dec(aCol);
3182: {$ELSE}
1.1.1.2 ! root 3183: aCol := (X - FLeftMargin) div FCharWidth;
1.1 root 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
1.1.1.2 ! root 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];
1.1 root 3239: end;
3240: {$ELSE}
1.1.1.2 ! root 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);
1.1 root 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}
1.1.1.2 ! root 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];
1.1 root 3258: {$ELSE}
1.1.1.2 ! root 3259: rc.Top := FTopMargin + FLineHeight * (FScreen.FRow - FTopLine);
1.1 root 3260: rc.Bottom := rc.Top + FLineHeight;
1.1.1.2 ! root 3261: rc.Left := FLeftMargin + FCharWidth * FScreen.FCol;
1.1 root 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}
1.1.1.2 ! root 3283: Result := FTopMargin + FLinePos[nRow];
1.1 root 3284: {$ELSE}
1.1.1.2 ! root 3285: Result := FTopMargin + nRow * FLineHeight;
1.1 root 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}
1.1.1.2 ! root 3297: Result := FLeftMargin + FCharPos[nCol];
1.1 root 3298: {$ELSE}
1.1.1.2 ! root 3299: Result := FLeftMargin + nCol * FCharWidth;
1.1 root 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;
1.1.1.2 ! root 3311: while (nRow > 0) and ((Y - FTopMargin) < FLinePos[nRow]) do
1.1 root 3312: Dec(nRow);
3313: {$ELSE}
1.1.1.2 ! root 3314: nRow := (Y - FTopMargin) div FLineHeight;
1.1 root 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;
1.1.1.2 ! root 3329: while (X - FLeftMargin) < FCharPos[nCol] do
1.1 root 3330: Dec(nCol);
3331: {$ELSE}
1.1.1.2 ! root 3332: nCol := (X - FLeftMargin) div FCharWidth;
1.1 root 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;
1.1.1.2 ! root 3719: nColTo : Integer;
! 3720: Blank : Boolean);
1.1 root 3721: var
1.1.1.2 ! root 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 = '';
1.1 root 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}
1.1.1.2 ! root 3765: X := FLeftMargin + FCharPos[nColFrom + nChr];
1.1 root 3766: rc.Top := Y + FInternalLeading;
3767: rc.Bottom := Y1 + FInternalLeading;
3768: rc.Left := X;
1.1.1.2 ! root 3769: rc.Right := FLeftMargin + FCharPos[nColFrom + nChr + 1];
1.1 root 3770: {$ELSE}
1.1.1.2 ! root 3771: X := FLeftMargin + (nColFrom + nChr) * FCharWidth;
1.1 root 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
1.1.1.2 ! root 3778: rc.Left := rc.Left - FLeftMargin;
1.1 root 3779: if (nColFrom + nChr) >= FScreen.FColCount then
1.1.1.2 ! root 3780: rc.Right := rc.Right + FRightMargin;
! 3781: if Blank then
! 3782: Ch := ' '
! 3783: else
! 3784: Ch := Line.Txt[nColFrom + nChr];
1.1 root 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;
1.1.1.2 ! root 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);
1.1 root 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;
1.1.1.2 ! root 3851: BackIndex : Integer;
1.1 root 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);
1.1.1.2 ! root 3873: if FMarginColor = -1 then
! 3874: BackIndex := FScreen.FAttribute div $0F
! 3875: else
! 3876: BackIndex := FMarginColor mod NumPaletteEntries;
! 3877: with FPaletteEntries[BackIndex] do
1.1 root 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}
1.1.1.2 ! root 3892: Y := FTopMargin + FLinePos[nRow];
! 3893: Y1 := FTopMargin + FLinePos[nRow + 1];
1.1 root 3894: {$ELSE}
1.1.1.2 ! root 3895: Y := FTopMargin + nRow * FLineHeight;
1.1 root 3896: Y1 := Y + FLineHeight;
3897: {$ENDIF}
3898:
1.1.1.2 ! root 3899: if rcPaint.Top <= FTopMargin then begin
1.1 root 3900: OldPen := SelectObject(DC, GetStockObject(NULL_PEN));
3901: WinProcs.Rectangle(DC, rcPaint.left, rcPaint.Top,
3902: rcPaint.Right + 1,
1.1.1.2 ! root 3903: FTopMargin + FInternalLeading + 1);
1.1 root 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;
1.1.1.2 ! root 3920: if rc.Bottom > (DrawRct.Bottom - FBottomMargin) then begin
1.1 root 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:
1.1.1.2 ! root 3936: PaintOneLine(DC, Y, Y1, Line, nColFrom, nCol, FALSE);
1.1 root 3937: nColFrom := nCol;
3938: end;
3939:
3940: nRow := nRow + 1;
3941: {$IFDEF CHAR_ZOOM}
1.1.1.2 ! root 3942: Y := FTopMargin + FLinePos[nRow - FTopLine];
! 3943: Y1 := FTopMargin + FLinePos[nRow + 1 - FTopLine];
1.1 root 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));
1.1.1.2 ! root 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;
1.1 root 3972: SelectObject(DC, OldPen);
3973:
3974: {$IFDEF CHAR_ZOOM}
1.1.1.2 ! root 3975: if (FLeftMargin + FCharPos[FScreen.FColCount]) < rc.Right then begin
1.1 root 3976: OldPen := SelectObject(DC, GetStockObject(NULL_PEN));
1.1.1.2 ! root 3977: WinProcs.Rectangle(DC, FLeftMargin + FCharPos[FScreen.FColCount],
! 3978: FTopMargin, { 09/03/99 }
1.1 root 3979: rcPaint.Right + 1, DrawRct.Bottom + 1);
3980: SelectObject(DC, OldPen);
3981: end;
3982: {$ELSE}
1.1.1.2 ! root 3983: if (FLeftMargin + FScreen.FColCount * FCharWidth) < rc.Right then begin
1.1 root 3984: OldPen := SelectObject(DC, GetStockObject(NULL_PEN));
1.1.1.2 ! root 3985: WinProcs.Rectangle(DC, FLeftMargin + FScreen.FColCount * FCharWidth,
! 3986: FTopMargin, rc.Right + 1, DrawRct.Bottom - 1);
1.1 root 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.