emulvt.pas

ics Internet 控件

var
    Temp : TLine;
    Row  : Integer;
begin
    Temp := Lines[FScrollRowBottom];
    for Row := FScrollRowBottom DownTo FScrollRowTop + 1 do
        Lines[Row] := Lines[Row - 1];
    Lines[FScrollRowTop] := Temp;
    Temp.Clear(F_WHITE {FAttribute});
    FAllInvalid := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.CursorDown;
begin
    Inc(FRow);
    if FRow > FScrollRowBottom then begin
        FRow := FScrollRowBottom;
        ScrollUp;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.CursorUp;
begin
    Dec(FRow);
    if FRow < 0 then begin
        Inc(FRow);
        ScrollDown;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.CursorRight;
begin
    Inc(FCol);
    if FCol >= FColCount then begin
        FCol := 0;
        CursorDown;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.CursorLeft;
begin
    Dec(FCol);
    if FCol < 0 then begin
        FCol := FColCount - 1;
        CursorUp;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.CarriageReturn;
begin
    FCol := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TScreen.GetEscapeParam(From : Integer; var Value : Integer) : Integer;
begin
    while (From <= Length(FEscBuffer)) and (FEscBuffer[From] = ' ') do
        From := From + 1;

    Value := 0;
    while (From <= Length(FEscBuffer)) and (FEscBuffer[From] in ['0'..'9']) do begin
        Value := Value * 10 + Ord(FEscBuffer[From]) - Ord('0');
        From := From + 1;
    end;

    Result := From;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.UnimplementedEscape(EscCmd : Char);
{var
    Buf : String;}
begin
    DebugString('Unimplemented Escape Sequence: ' + FEscBuffer + EscCmd + #13 + #10);
{   Buf := FEscBuffer + EscCmd + #0;
    MessageBox(0, @Buf[1], 'Unimplemented Escape Sequence', MB_OK); }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.InvalidEscape(EscCmd : Char);
{var
    Buf : String;}
begin
    DebugString('Invalid Escape Sequence: ' + FEscBuffer + EscCmd + #13 + #10);
{   Buf := FEscBuffer + EscCmd + #0;
    MessageBox(0, @Buf[1], 'Invalid Escape Sequence', MB_OK); }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessESC_D;                   { Index                   }
begin
    UnimplementedEscape('D');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Move cursor Up, scroll down if necessary                                  }
procedure TScreen.ProcessESC_M;                   { Reverse index           }
begin
    Dec(FRow);
    if FRow < FScrollRowTop then begin
        FRow := FScrollRowTop;
        ScrollDown;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessESC_E;                   { Next line               }
begin
    UnimplementedEscape('E');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_u;                  { Restore Cursor          }
begin
    UnimplementedEscape('u');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ IBM character set operation (not part of the ANSI standard)		    }
{ <ESC>[0I		=> Set IBM character set			    }
{ <ESC>[1;nnnI		=> Literal mode for nnn next characters		    }
{ <ESC>[2;onoffI	=> Switch carbon mode on (1) or off (0)		    }
{ <ESC>[3;ch;cl;sh;slI	=> Receive carbon mode keyboard code		    }
{ <ESC>[4I              => Select ANSI character set                        }
procedure TScreen.ProcessCSI_I;
var
    From, mode, nnn : Integer;
    ch, cl, sh, sl  : Integer;
begin
    From := GetEscapeParam(2, Mode);

    case Mode of
    0:  begin                { Select IBM character set                     }
            FNoXlat := TRUE;
        end;
    1:	begin                { Set literal mode for next N characters       }
            if FEscBuffer[From] = ';' then
                GetEscapeParam(From + 1, FCntLiteral)
            else
                FCntLiteral := 1;
        end;
    2:	begin		     { Switch carbon mode on or off                 }
            if FEscBuffer[From] = ';' then
                GetEscapeParam(From + 1, nnn)
            else
                nnn := 0;
            FCarbonMode := (nnn <> 0);
        end;
    3:	begin		     { Receive carbon mode key code                 }
            ch := 0; cl := 0; sh := 0; sl := 0;
            if FEscBuffer[From] = ';' then begin
                From := GetEscapeParam(From + 1, cl);
                if FEscBuffer[From] = ';' then begin
                    From := GetEscapeParam(From + 1, ch);
                    if FEscBuffer[From] = ';' then begin
                        From := GetEscapeParam(From + 1, sl);
                        if FEscBuffer[From] = ';' then begin
                            GetEscapeParam(From + 1, sh);
                        end;
                    end;
                end;
            end;
            DebugString('Special key ' +
                        IntToHex(ch, 2) + IntToHex(cl, 2) + ' ' +
                        IntToHex(sh, 2) + IntToHex(sl, 2));
        end;
    4:	begin		     { Select ANSI character set                    }
            FNoXlat := FALSE;
        end;
    else
        UnimplementedEscape('I');
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.BackSpace;
begin
    if FCol > 0 then
        Dec(FCol);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ClearScreen;
var
    Row : Integer;
begin
    for Row := 0 to FRowCount - 1 do
        Lines[Row].Clear(FAttribute);
    FRow := 0;
    FCol := 0;
    FAllInvalid := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.InvClear;
begin
    with FInvRect do begin
        Top    := 9999;
        Left   := 9999;
        Right  := -1;
        Bottom := -1;
    end;
    FAllInvalid := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.InvRect(nRow, nCol : Integer);
begin
    if not FAllInvalid then begin
        if FInvRect.Top > nRow then
            FInvRect.Top := nRow;
        if FInvRect.Bottom < nRow then
            FInvRect.Bottom := nRow;
        if FInvRect.Left > nCol then
            FInvRect.Left := nCol;
        if FInvRect.Right < nCol then
            FInvRect.Right := nCol;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ The FLines array is inverted with the last host line at position 0 and
  the first host line as position FRowCount - 1. }
procedure Tscreen.SetLines(I : Integer; Value : TLine);
begin
    if I >= FRowCount then
        FLines^[0] := Value
    else
        FLines^[FRowCount - 1 - I] := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TScreen.GetLines(I : Integer) : TLine;
begin
    if I >= FRowCount then
        Result := FLines^[0]
    else
        Result := FLines^[FRowCount - 1 - I];
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.Eol;
begin
    with Lines[FRow] do begin
        FillChar(Txt[FCol], FColCount - FCol, ' ');
        FillChar(Att[FCol], (FColCount - FCol) * SizeOf(Att[FCol]), FAttribute);
    end;
    InvRect(Frow, FCol);
    InvRect(Frow, FColCount);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.Eop;
var
    NRow : Integer;
begin
    Eol;
    for NRow := FRow + 1 to FRowCount - 1 do
        Lines[NRow].Clear(FAttribute);
    if FRow = 0 then
        FAllInvalid := TRUE
    else begin
       InvRect(FRow, 0);
       InvRect(FRowCount, FColCount);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_J;                  { Clear the screen         }
var
    Mode : Integer;
    Row  : Integer;
begin
    GetEscapeParam(2, Mode);
    case Mode of
    0: begin                                   { Cursor to end of screen    }
           FAttribute := F_WHITE;
           Eop;
       end;
    1: begin                                   { Start of screen to cursor  }
           for Row := 0 to FRow do
               Lines[Row].Clear(FAttribute);
           InvRect(0, 0);
           InvRect(FRow, FColCount);
       end;
    2: begin