?? emulvt.pas
字號:
unit Emulvt;
{$B-} { Partial boolean evaluation }
interface
{$DEFINE SINGLE_CHAR_PAINT}
{$DEFINE CHAR_ZOOM}
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ClipBrd;
const
EmulVTVersion = 212;
CopyRight : String = 'TEmulVT';
MAX_ROW = 50;
MAX_COL = 132;
TopMargin = 0;
LeftMargin = 0;
RightMargin = 0;
BottomMargin = 0;
NumPaletteEntries = 16;
type
TBackColors = (vtsBlack, vtsRed, vtsGreen, vtsYellow,
vtsBlue, vtsMagenta, vtsCyan, vtsWhite);
TScreenOption = (vtoBackColor, vtoCopyBackOnClear);
TScreenOptions = set of TScreenOption;
TXlatTable = array [0..255] of char;
PXlatTable = ^TXlatTable;
TFuncKeyValue = String[50];
PFuncKeyValue = ^TFuncKeyValue;
TFuncKey = record
ScanCode : Char;
Shift : TShiftState;
Ext : Boolean;
Value : TFuncKeyValue;
end;
TFuncKeysTable = array [0..63] of TFuncKey;
PFuncKeysTable = ^TFuncKeysTable;
TKeyBufferEvent = procedure (Sender : TObject; Buffer : PChar; Len : Integer) of object;
TKeyDownEvent = procedure (Sender : TObject;
var VirtKey : Integer;
var Shift : TShiftState;
var ShiftLock : Boolean;
var ScanCode : Char;
var Ext : Boolean) of object;
type
{ TLine is an object used to hold one line of text on screen }
TLine = class(TObject)
public
Txt : array [0..MAX_COL] of char;
Att : array [0..MAX_COL] of Byte;
constructor Create;
procedure Clear(Attr : Byte);
end;
TLineArray = array [0..16382] of TLine;
PLineArray = ^TLineArray;
{ TScreen is an object to hold an entire screen of line and handle }
{ Ansi escape sequences to update this virtual screen }
TScreen = class(TObject)
public
FLines : PLineArray;
FRow : Integer;
FCol : Integer;
FRowSaved : Integer;
FColSaved : Integer;
FScrollRowTop : Integer;
FScrollRowBottom : Integer;
FAttribute : Byte;
FForceHighBit : Boolean;
FReverseVideo : Boolean;
FUnderLine : Boolean;
FRowCount : Integer;
FColCount : Integer;
FBackRowCount : Integer;
FBackEndRow : Integer;
FBackColor : TBackColors;
FOptions : TScreenOptions;
FEscBuffer : String[80];
FEscFlag : Boolean;
Focused : Boolean;
FAutoLF : Boolean;
FAutoCR : Boolean;
FAutoWrap : Boolean;
FCursorOff : Boolean;
FCKeyMode : Boolean;
FNoXlat : Boolean;
FNoXlatInitial : Boolean;
FCntLiteral : Integer;
FCarbonMode : Boolean;
FXlatInputTable : PXlatTable;
FXlatOutputTable : PXlatTable;
FCharSetG0 : Char;
FCharSetG1 : Char;
FCharSetG2 : Char;
FCharSetG3 : Char;
FAllInvalid : Boolean;
FInvRect : TRect;
FOnCursorVisible : TNotifyEvent;
constructor Create;
destructor Destroy; override;
procedure AdjustFLines(NewCount : Integer);
procedure CopyScreenToBack;
procedure SetRowCount(NewCount : Integer);
procedure SetBackRowCount(NewCount : Integer);
procedure InvRect(nRow, nCol : Integer);
procedure InvClear;
procedure SetLines(I : Integer; Value : TLine);
function GetLines(I : Integer) : TLine;
procedure WriteChar(Ch : Char);
procedure WriteStr(Str : String);
function ReadStr : String;
procedure GotoXY(X, Y : Integer);
procedure WriteLiteralChar(Ch : Char);
procedure ProcessEscape(EscCmd : Char);
procedure SetAttr(Att : Char);
procedure CursorRight;
procedure CursorLeft;
procedure CursorDown;
procedure CursorUp;
procedure CarriageReturn;
procedure ScrollUp;
procedure ScrollDown;
procedure ClearScreen;
procedure BackSpace;
procedure Eol;
procedure Eop;
procedure ProcessESC_D; { Index }
procedure ProcessESC_M; { Reverse index }
procedure ProcessESC_E; { Next line }
procedure ProcessCSI_u; { Restore Cursor }
procedure ProcessCSI_I; { Select IBM char set }
procedure ProcessCSI_J; { Clear the screen }
procedure ProcessCSI_K; { Erase to End of Line }
procedure ProcessCSI_L; { Insert Line }
procedure ProcessCSI_M; { Delete Line }
procedure ProcessCSI_m_lc; { Select Attributes }
procedure ProcessCSI_n_lc; { Cursor position report }
procedure ProcessCSI_at; { Insert character }
procedure ProcessCSI_r_lc; { Scrolling margins }
procedure ProcessCSI_s_lc; { Save cursor location }
procedure ProcessCSI_u_lc; { Restore cursor location }
procedure ProcessCSI_7; { Save cursor location }
procedure ProcessCSI_8; { Restore cursor location }
procedure ProcessCSI_H; { Set Cursor Position }
procedure ProcessCSI_h_lc; { Terminal mode set }
procedure ProcessCSI_l_lc; { Terminal mode reset }
procedure ProcessCSI_A; { Cursor Up }
procedure ProcessCSI_B; { Cursor Down }
procedure ProcessCSI_C; { Cursor Right }
procedure ProcessCSI_D; { Cursor Left }
procedure ProcessCSI_P; { Delete Character }
procedure ProcessCSI_S; { Scroll up }
procedure ProcessCSI_T; { Scroll down }
procedure process_charset_G0(EscCmd : Char);{ G0 character set }
procedure process_charset_G1(EscCmd : Char);{ G1 character set }
procedure process_charset_G2(EscCmd : Char);{ G2 character set }
procedure process_charset_G3(EscCmd : Char);{ G3 character set }
procedure UnimplementedEscape(EscCmd : Char);
procedure InvalidEscape(EscCmd : Char);
function GetEscapeParam(From : Integer; var Value : Integer) : Integer;
property OnCursorVisible : TNotifyEvent read FonCursorVisible
write FOnCursorVisible;
property Lines[I : Integer] : TLine read GetLines write SetLines;
end;
{ TCustomEmulVT is an visual component wich does the actual display }
{ of a TScreen object wich is the virtual screen }
{ No property is published. See TEmulVT class }
TCustomEmulVT = class(TCustomControl)
private
FScreen : TScreen;
FFileHandle : TextFile;
FCursorVisible : Boolean;
FCaretShown : Boolean;
FCaretCreated : Boolean;
FLineHeight : Integer;
FLineZoom : Single;
FCharWidth : Integer;
FCharZoom : Single;
FGraphicDraw : Boolean;
FInternalLeading : Integer;
FBorderStyle : TBorderStyle;
FBorderWidth : Integer;
FAutoRepaint : Boolean;
FFont : TFont;
FVScrollBar : TScrollBar;
FTopLine : Integer;
FLocalEcho : Boolean;
FOnKeyBuffer : TKeyBufferEvent;
FOnKeyDown : TKeyDownEvent;
FFKeys : Integer;
FMonoChrome : Boolean;
FLog : Boolean;
FAppOnMessage : TMessageEvent;
FFlagCirconflexe : Boolean;
FFlagTrema : Boolean;
FSelectRect : TRect;
FPal : HPalette;
FPaletteEntries : array[0..NumPaletteEntries - 1] of TPaletteEntry;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMPaletteChanged(var Message : TMessage); message WM_PALETTECHANGED;
procedure VScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure SetCaret;
procedure AdjustScrollBar;
procedure KeyPress(var Key: Char); override;
function ProcessFKeys(ScanCode: Char; Shift: TShiftState; Ext: Boolean) : Boolean;
function FindFKeys(ScanCode: Char; Shift: TShiftState;
Ext: Boolean) : PFuncKeyValue;
procedure CursorVisibleEvent(Sender : TObject);
procedure SetFont(Value : TFont);
procedure SetAutoLF(Value : Boolean);
procedure SetAutoCR(Value : Boolean);
procedure SetXlat(Value : Boolean);
procedure SetLog(Value : Boolean);
procedure SetRows(Value : Integer);
procedure SetCols(Value : Integer);
procedure SetBackRows(Value : Integer);
procedure SetTopLine(Value : Integer);
procedure SetBackColor(Value : TBackColors);
procedure SetOptions(Value : TScreenOptions);
procedure SetLineHeight(Value : Integer);
function GetAutoLF : Boolean;
function GetAutoCR : Boolean;
function GetXlat : Boolean;
function GetRows : Integer;
function GetCols : Integer;
function GetBackRows : Integer;
function GetBackColor : TBackColors;
function GetOptions : TScreenOptions;
protected
procedure AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
procedure DoKeyBuffer(Buffer : PChar; Len : Integer); virtual;
procedure PaintGraphicChar(DC : HDC;
X, Y : Integer;
rc : PRect;
ch : Char);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ShowCursor;
procedure SetCursor(Row, Col : Integer);
procedure WriteChar(Ch : Char);
procedure WriteStr(Str : String);
procedure WriteBuffer(Buffer : Pointer; Len : Integer);
function ReadStr : String;
procedure CopyHostScreen;
procedure Clear;
procedure UpdateScreen;
function SnapPixelToRow(Y : Integer) : Integer;
function SnapPixelToCol(X : Integer) : Integer;
function PixelToRow(Y : Integer) : Integer;
function PixelToCol(X : Integer) : Integer;
procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
procedure SetLineZoom(newValue : Single);
procedure SetCharWidth(newValue : Integer);
procedure SetCharZoom(newValue : Single);
property LineZoom : Single read FLineZoom write SetLineZoom;
property CharWidth : Integer read FCharWidth write SetCharWidth;
property CharZoom : Single read FCharZoom write SetCharZoom;
property GraphicDraw : Boolean read FGraphicDraw write FGraphicDraw;
property TopLine : Integer read FTopLine write SetTopLine;
property VScrollBar : TScrollBar read FVScrollBar;
private
procedure PaintOneLine(DC: HDC; Y, Y1 : Integer; const Line : TLine;
nColFrom : Integer; nColTo : Integer);
procedure SetupFont;
property Text : String read ReadStr write WriteStr;
property OnMouseMove;
property OnMouseDown;
property OnMouseUp;
property OnClick;
property OnKeyPress;
property OnKeyBuffer : TKeyBufferEvent read FOnKeyBuffer write FOnKeyBuffer;
property OnKeyDown : TKeyDownEvent read FOnKeyDown write FOnKeyDown;
property Ctl3D;
property Align;
property TabStop;
property TabOrder;
property BorderStyle: TBorderStyle read FBorderStyle write FBorderStyle;
property AutoRepaint : Boolean read FAutoRepaint write FAutoRepaint;
property Font : TFont read FFont write SetFont;
property LocalEcho : Boolean read FLocalEcho write FLocalEcho;
property AutoLF : Boolean read GetAutoLF write SetAutoLF;
property AutoCR : Boolean read GetAutoCR write SetAutoCR;
property Xlat : Boolean read GetXlat write SetXlat;
property MonoChrome : Boolean read FMonoChrome write FMonoChrome;
property Log : Boolean read FLog write SetLog;
property Rows : Integer read GetRows write SetRows;
property Cols : Integer read GetCols write SetCols;
property LineHeight : Integer read FLineHeight write SetLineHeight;
property FKeys : Integer read FFKeys write FFKeys;
property SelectRect : TRect read FSelectRect write FSelectRect;
property BackRows : Integer read GetBackRows write SetBackRows;
property BackColor : TBackColors read GetBackColor write SetBackColor;
property Options : TScreenOptions read GetOptions write SetOptions;
end;
{ Same as TCustomEmulVT, but with published properties }
TEmulVT = class(TCustomEmulVT)
public
property Screen : TScreen read FScreen;
property SelectRect;
property Text;
published
property OnMouseMove;
property OnMouseDown;
property OnMouseUp;
property OnClick;
property OnKeyPress;
property OnKeyDown;
property OnKeyBuffer;
property Ctl3D;
property Align;
property BorderStyle;
property AutoRepaint;
property Font;
property LocalEcho;
property AutoLF;
property AutoCR;
property Xlat;
property MonoChrome;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -