adtrmbuf.pas

测试用例

                                  aAbsolute : boolean) : integer;
      function tbCvtToExternalRow(aRow : integer;
                                  aAbsolute : boolean) : integer;

      function tbAtLastColumn : boolean;
      procedure tbMoveCursorLeftRight(aDirection : integer;
                                      aWrap      : boolean;
                                      aScroll    : boolean);
      procedure tbMoveCursorUpDown(aDirection : integer;
                                   aScroll    : boolean);
      procedure tbReallocBuffers(aNewRowCount : integer;
                                 aNewColCount : integer);
      procedure tbScrollRows(aCount, aTop, aBottom : integer);
      procedure tbFireOnCursorMovedEvent;                              

    public
      constructor Create(aUseWideChars : boolean);
      destructor Destroy; override;

      {---METHODS---}
      {character attributes}
      procedure GetCharAttrs(var aValue : TAdTerminalCharAttrs);
      procedure GetDefCharAttrs(var aValue : TAdTerminalCharAttrs);
      procedure SetDefCharAttrs(const aValue : TAdTerminalCharAttrs);
      procedure SetCharAttrs(const aValue : TAdTerminalCharAttrs);

      {cursor movement}
      procedure MoveCursorDown(aScroll : boolean);
      procedure MoveCursorLeft(aWrap : boolean; aScroll : boolean);
      procedure MoveCursorRight(aWrap : boolean; aScroll : boolean);
      procedure MoveCursorUp(aScroll : boolean);
      procedure SetCursorPosition(aRow, aCol : integer);

      {insertion/deletion}
      procedure DeleteChars(aCount : integer);
      procedure DeleteLines(aCount : integer);
      procedure InsertChars(aCount : integer);
      procedure InsertLines(aCount : integer);

      {erasing}
      procedure EraseAll;
      procedure EraseChars(aCount : integer);
      procedure EraseFromBOW;
      procedure EraseFromBOL;
      procedure EraseLine;
      procedure EraseScreen;
      procedure EraseToEOL;
      procedure EraseToEOW;

      {horizontal tab stop control}
      procedure SetHorzTabStop;
      procedure ClearHorzTabStop;
      procedure ClearAllHorzTabStops;
      procedure DoHorzTab;
      procedure DoBackHorzTab;

      {vertical tab stop control}
      procedure SetVertTabStop;
      procedure ClearVertTabStop;
      procedure ClearAllVertTabStops;
      procedure DoVertTab;
      procedure DoBackVertTab;

      {scrolling regions}
      procedure SetScrollRegion(aTopRow, aBottomRow : integer);

      {write character/string}
      procedure WriteChar(aCh : char);
      procedure WriteString(const aSt : string);

      {miscellaneous special processing}
      procedure DoBackspace;
      procedure DoCarriageReturn;
      procedure DoLineFeed;
      procedure Reset;

      {get buffer information}
      function GetLineCharPtr(aRow : integer) : pointer;
      function GetLineAttrPtr(aRow : integer) : pointer;
      function GetLineForeColorPtr(aRow : integer) : pointer;
      function GetLineBackColorPtr(aRow : integer) : pointer;
      function GetLineCharSetPtr(aRow : integer) : pointer;

      {getting information about changes}
      function HasCursorMoved : boolean;
      function HasDisplayChanged : boolean;
      function GetInvalidRect(var aRect : TRect) : boolean;

      {Misc. Internal}
      procedure RegisterTerminalHandle (AHandle : THandle);              {!!.05}
      procedure DeregisterTerminalHandle;                                {!!.05}

      {---PROPERTIES---}
      {color, charsets}
      property BackColor : TColor read FBackColor write tbSetBackColor;
      property CharSet : byte read FCharSet write tbSetCharSet;
      property DefAnsiChar : AnsiChar read FDefAnsiChar write tbSetDefAnsiChar;
      property DefBackColor : TColor read FDefBackColor write tbSetDefBackColor;
      property DefCharSet : byte read FDefCharSet write FDefCharSet;
      property DefForeColor : TColor read FDefForeColor write tbSetDefForeColor;
      property ForeColor : TColor read FForeColor write tbSetForeColor;

      {scrollback view extent}
      property SVRowCount : integer read FSVRowCount write tbSetSVRowCount;

      {display view properties}
      property Col : integer read tbGetCol write tbSetCol;
      property ColCount : integer read FColCount write tbSetColCount;
      property OriginCol : integer read tbGetOriginCol;
      property OriginRow : integer read tbGetOriginRow;
      property Row : integer read tbGetRow write tbSetRow;
      property RowCount : integer read FRowCount write tbSetRowCount;

      property UseAbsAddress : boolean
                  read FUseAbsAddress write FUseAbsAddress;
      property UseAutoWrap : boolean
                  read FUseAutoWrap write FUseAutoWrap;
      property UseAutoWrapDelay : boolean
                  read FUseAutoWrapDelay write FUseAutoWrapDelay;
      property UseInsertMode : boolean
                  read FUseInsertMode write FUseInsertMode;
      property UseNewLineMode : boolean
                  read FUseNewLineMode write FUseNewLineMode;
      property UseScrollRegion : boolean
                  read FUseScrollRegion write tbSetUseScrollRegion;
      property UseWideChars : boolean read FUseWideChars;

      property OnScrollRows : TAdScrollRowsNotifyEvent
                  read FOnScrollRows write FOnScrollRows;

      { OnCursorMoved
        This property is used to notify the TAdTerminal component when
        the cursor moves.  It should not be used for your own purposes
        as that may cause unexpected behaviour in the terminal }       
        
      property OnCursorMoved : TAdOnCursorMovedEvent                   
                  read FOnCursorMoved write FOnCursorMoved;            
  end;

procedure RaiseTerminalException(aClass : EAdTerminalClass;
                                 aErrorCode : longint;
                           const aStrParam1 : string;
                           const aStrParam2 : string;
                           const aStrParam3 : string;
                                 aIntParam1 : longint;
                                 aIntParam2 : longint;
                                 aIntParam3 : longint);

implementation

type
  PByte = ^byte;
  PWord = ^word;
  PLongint = ^longint;

{===Exceptions=======================================================}
procedure RaiseTerminalException(aClass : EAdTerminalClass;
                                 aErrorCode : longint;
                           const aStrParam1 : string;
                           const aStrParam2 : string;
                           const aStrParam3 : string;
                                 aIntParam1 : longint;
                                 aIntParam2 : longint;
                                 aIntParam3 : longint);
begin
  raise aClass.Create(aErrorCode, false);
end;
{====================================================================}



{===TadTerminalArray=================================================}
constructor TadTerminalArray.Create(aItemSize : integer);
begin
  inherited Create;
  {save a valid item size}
  case aItemSize of
    1, 2, 4 : FItemSize := aItemSize;
  else
    FItemSize := 1;
  end;{case}
  {set the actual column count to -1, which means 'uncalculated'}
  FActColCount := -1;
end;
{--------}
destructor TadTerminalArray.Destroy;
begin
  if (FItems <> nil) then begin
    FreeMem(FItems, RowCount * FActColCount * ItemSize);
  end;
  inherited Destroy;
end;
{--------}
procedure TadTerminalArray.Clear;
begin
  if (FItems <> nil) then
    taClearRows(FItems, FActColCount, 0, pred(RowCount));
end;
{--------}
procedure TadTerminalArray.ClearItems(aRow : integer;
                                      aFromCol, aToCol : integer);
var
  Walker    : PAnsiChar;
  Value     : longint;
  i         : integer;
begin
  Walker := @FItems[((aRow * FActColCount) + aFromCol) * ItemSize];
  case ItemSize of
    1 : FillChar(Walker^, succ(aToCol - aFromCol), byte(FDefaultItem));
    2 : begin
          Value := word(FDefaultItem);
          for i := 0 to (aToCol - aFromCol) do begin
            PWord(Walker)^ := Value;
            inc(Walker, 2);
          end;
        end;
    4 : begin
          Value := FDefaultItem;
          for i := 0 to (aToCol - aFromCol) do begin
            PLongint(Walker)^ := Value;
            inc(Walker, 4);
          end;
        end;
  end;{case}
end;
{--------}
procedure TadTerminalArray.DeleteItems(aCount : integer;
                                       aRow   : integer;
                                       aCol   : integer);
var
  ItemCount : integer;
  Distance  : integer;
  FromPtr   : PAnsiChar;
  ToPtr     : PAnsiChar;
  Value     : longint;
  i         : integer;
begin
  {$IFDEF UseRangeChecks}
  {Range check aRow and aCol}
  if (aRow < 0) or (aRow >= RowCount) or
     (aCol < 0) or (aCol >= ColCount) then
    raise Exception.Create(
             Format('TadTerminalArray.DeleteItems: either row %d or col %d is out of range',
                    [aRow, aCol]));
  {$ENDIF}
  Distance := ColCount - aCol;
  if (Distance > aCount) then
    Distance := aCount;
  ItemCount := ColCount - aCol - Distance;
  case ItemSize of
    1 : begin
          ToPtr := @FItems[(aRow * FActColCount) + aCol];
          if (ItemCount > 0) then begin
            FromPtr := ToPtr + Distance;
            Move(FromPtr^, ToPtr^, ItemCount);
          end;
          ToPtr := ToPtr + ItemCount;
          FillChar(ToPtr^, Distance, byte(FDefaultItem));
        end;
    2 : begin
          ToPtr := @FItems[((aRow * FActColCount) + aCol) * 2];
          if (ItemCount > 0) then begin
            FromPtr := ToPtr + (Distance * 2);
            Move(FromPtr^, ToPtr^, ItemCount * 2);
          end;
          ToPtr := ToPtr + (ItemCount * 2);
          Value := word(FDefaultItem);
          for i := 0 to pred(Distance) do begin
            PWord(ToPtr)^ := Value;
            inc(ToPtr, 2);
          end;
        end;
    4 : begin
          ToPtr := @FItems[((aRow * FActColCount) + aCol) * 4];
          if (ItemCount > 0) then begin
            FromPtr := ToPtr + (Distance * 4);
            Move(FromPtr^, ToPtr^, ItemCount * 4);
          end;
          ToPtr := ToPtr + (ItemCount * 4);
          Value := FDefaultItem;
          for i := 0 to pred(Distance) do begin
            PLongint(ToPtr)^ := Value;
            inc(ToPtr, 4);
          end;
        end;
  end;{case}
end;
{--------}
function TadTerminalArray.GetItemPtr(aRow, aCol : integer) : pointer;
begin
  {$IFDEF UseRangeChecks}
  {Range check aRow and aCol}
  if (aRow < 0) or (aRow >= RowCount) or
     (aCol < 0) or (aCol >= ColCount) then
    raise Exception.Create(
             Format('TadTerminalArray.GetItemPtr: either row %d or col %d is out of range',
                    [aRow, aCol]));
  {$ENDIF}
  if FItems = nil then
    Result := nil
  else begin
    case ItemSize of
      1 : Result := @FItems[(aRow * FActColCount) + aCol];
      2 : Result := @FItems[(aRow * FActColCount * 2) + (aCol * 2)];
      4 : Result := @FItems[(aRow * FActColCount * 4) + (aCol * 4)];
    else
      raise Exception.Create('TadTerminalArray.GetItemPtr: invalid item size');
      Result := nil;
    end;{case}
  end;
end;
{--------}
procedure TadTerminalArray.InsertItems(aCount : integer;
                                       aRow   : integer;
                                       aCol   : integer);
var
  ItemCount : integer;
  Distance  : integer;
  FromPtr   : PAnsiChar;
  ToPtr     : PAnsiChar;
  Value     : longint;
  i         : integer;
begin
  {$IFDEF UseRangeChecks}
  {Range check aRow and aCol}
  if (aRow < 0) or (aRow >= RowCount) or
     (aCol < 0) or (aCol >= ColCount) then
    raise Exception.Create(
             Format('TadTerminalArray.InsertItems: either row %d or col %d is out of range',
                    [aRow, aCol]));
  {$ENDIF}
  Distance := ColCount - aCol;
  if (Distance > aCount) then
    Distance := aCount;
  ItemCount := ColCount - aCol - Distance;
  case ItemSize of
    1 : begin
          FromPtr := @FItems[(aRow * FActColCount) + aCol];
          if (ItemCount > 0) then begin
            ToPtr := FromPtr + Distance;
            Move(FromPtr^, ToPtr^, ItemCount);
          end;
          FillChar(FromPtr^, Distance, byte(FDefaultItem));
        end;
    2 : begin
          FromPtr := @FItems[((aRow * FActColCount) + aCol) * 2];
          if (ItemCount > 0) then begin
            ToPtr := FromPtr + (Distance * 2);
            Move(FromPtr^, ToPtr^, ItemCount * 2);
          end;
          Value := word(FDefaultItem);
          for i := 0 to pred(Distance) do begin
            PWord(FromPtr)^ := Value;
            inc(FromPtr, 2);
          end;
        end;
    4 : begin
          FromPtr := @FItems[((aRow * FActColCount) + aCol) * 4];
          if (ItemCount > 0) then begin