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