adtrmbuf.pas

测试用例

            ToPtr := FromPtr + (Distance * 4);
            Move(ToPtr^, FromPtr^, ItemCount * 4);
          end;
          Value := FDefaultItem;
          for i := 0 to pred(Distance) do begin
            PLongint(FromPtr)^ := Value;
            inc(FromPtr, 4);
          end;
        end;
  end;{case}
end;
{--------}
procedure TadTerminalArray.ReplaceItems(aOldItem : pointer;
                                        aNewItem : pointer);
                                                           {new !!.02}
var
  Walker    : PAnsiChar;
  OldValue  : longint;
  NewValue  : longint;
  Row       : integer;
  i         : integer;
begin
  case ItemSize of
    1 : begin
          OldValue := PByte(aOldItem)^;
          NewValue := PByte(aNewItem)^;
        end;
    2 : begin
          OldValue := PWord(aOldItem)^;
          NewValue := PWord(aNewItem)^;
        end;
    4 : begin
          OldValue := PLongint(aOldItem)^;
          NewValue := PLongint(aNewItem)^;
        end;
  else
    {dummy statements that will never get executed, however they fool
     the warning analyzer in the compiler}
    OldValue := 0;
    NewValue := 0;
  end;{case}
  for Row := 0 to pred(RowCount) do begin
    Walker := @FItems[(Row * FActColCount) * ItemSize];
    case ItemSize of
      1 : for i := 0 to pred(ColCount) do begin
            if (PByte(Walker)^ = OldValue) then
               PByte(Walker)^ := NewValue;
            inc(Walker);
          end;
      2 : for i := 0 to pred(ColCount) do begin
            if (PWord(Walker)^ = OldValue) then
               PWord(Walker)^ := NewValue;
            inc(Walker, 2);
          end;
      4 : for i := 0 to pred(ColCount) do begin
            if (PLongint(Walker)^ = OldValue) then
               PLongint(Walker)^ := NewValue;
            inc(Walker, 4);
          end;
    end;{case}
  end;
end;
{--------}
procedure TadTerminalArray.ScrollRows(aCount : integer;
                                      aStartRow, aEndRow : integer);
var
  ThisRow : integer;
  FromPtr : PAnsiChar;
  ToPtr   : PAnsiChar;
  i       : integer;
begin
  {$IFDEF UseRangeChecks}
  {Range check aStartRow and aEndRow}
  if (aStartRow < 0) or (aStartRow >= RowCount) or
     (aEndRow < 0) or (aEndRow >= RowCount) then
    raise Exception.Create(
             Format('TadTerminalArray.ScrollRows: either start row %d or end row %d is out of range',
                    [aStartRow, aEndRow]));
  {$ENDIF}
  if (FItems <> nil) and (aCount <> 0) then begin
    {make sure the end row is larger than the start row}
    if (aEndRow < aStartRow) then begin
      ThisRow := aEndRow;
      aEndRow := aStartRow;
      aStartRow := ThisRow;
    end;
    {split the code depending on whether we are scrolling upwards,
     aCount is +ve, or downwards, aCount is -ve}
    if (aCount > 0) then {scroll upwards} begin
      {if the number of rows to scroll is greater than the difference
       between the start and end rows, all we need to do is blank out
       all the rows between start and end inclusive, otherwise we have
       some scrolling to do}
      ThisRow := aStartRow;
      if (aCount <= (aEndRow - aStartRow)) then begin
        ToPtr := @FItems[ThisRow * FActColCount * ItemSize];
        FromPtr := @FItems[(ThisRow + aCount) * FActColCount * ItemSize];
        for i := 0 to (aEndRow - aStartRow - aCount) do begin
          Move(FromPtr^, ToPtr^, ColCount * ItemSize);
          inc(FromPtr, FActColCount * ItemSize);
          inc(ToPtr, FActColCount * ItemSize);
          inc(ThisRow);
        end;
      end;
      {now blank out everything from ThisRow to aEndRow}
      taClearRows(FItems, FActColCount, ThisRow, aEndRow);
    end
    else {scroll downwards} begin
      {if the number of rows to scroll is greater than the difference
       between the start and end rows, all we need to do is blank out
       all the rows between start and end inclusive, otherwise we have
       some scrolling to do}
      aCount := -aCount;
      ThisRow := aEndRow;
      if (aCount <= (aEndRow - aStartRow)) then begin
        ToPtr := @FItems[ThisRow * FActColCount * ItemSize];
        FromPtr := @FItems[(ThisRow - aCount) * FActColCount * ItemSize];
        for i := 0 to (aEndRow - aStartRow - aCount) do begin
          Move(FromPtr^, ToPtr^, ColCount * ItemSize);
          dec(FromPtr, FActColCount * ItemSize);
          dec(ToPtr, FActColCount * ItemSize);
          dec(ThisRow);
        end;
      end;
      {now blank out everything from aStartRow to ThisRow}
      taClearRows(FItems, FActColCount, aStartRow, ThisRow);
    end;
  end;
end;
{--------}
procedure TadTerminalArray.SetDefaultItem(aDefaultItem : pointer);
begin
  case ItemSize of
    1 : FDefaultItem := PByte(aDefaultItem)^;
    2 : FDefaultItem := PWord(aDefaultItem)^;
    4 : FDefaultItem := PLongint(aDefaultItem)^;
  end;
end;
{--------}
procedure TadTerminalArray.taClearRows(aBuffer : PAnsiChar;
                                       aActColCount : integer;
                                       aStartRow, aEndRow : integer);
var
  Walker     : PAnsiChar;
  Value      : longint;
  DWORDCount : integer;
  i          : integer;
begin
  Walker := @aBuffer[aStartRow * aActColCount * ItemSize];
  if (ItemSize = 1) then
    FillChar(Walker^,
             succ(aEndRow - aStartRow) * aActColCount,
             byte(FDefaultItem))
  else begin
    if (ItemSize = 2) then begin
      Value := (FDefaultItem shl 16) + word(FDefaultItem);
      DWORDCount := (succ(aEndRow - aStartRow) * aActColCount) div 2;
    end
    else begin
      Value := FDefaultItem;
      DWORDCount := succ(aEndRow - aStartRow) * aActColCount;
    end;
    for i := 0 to pred(DWORDCount) do begin
      PLongint(Walker)^ := Value;
      inc(Walker, 4);
    end;
  end;
end;
{--------}
procedure TadTerminalArray.taGrowArray(aRowCount,
                                       aColCount,
                                       aActColCount : integer);
var
  NewArray : PAnsiChar;
  RowSize  : integer;
  NumRows  : integer;
  FromPtr  : PAnsiChar;
  ToPtr    : PAnsiChar;
  i        : integer;
begin
  {make sure we have the new actual column count: this is the external
   column count rounded up so that the actual length of a row in bytes
   is a multiple of four--this makes fills and moves much faster}
  if (aActColCount = -1) then begin
    case ItemSize of
      1 : aActColCount := ((aColCount + 3) div 4) * 4;
      2 : aActColCount := ((aColCount + 1) div 2) * 2;
      4 : aActColCount := aColCount;
    end;{case}
  end;
  {nothing to do if either the row or actual column count is zero}
  if (aRowCount = 0) or (aActColCount = 0) then
    Exit;
  {equally obvious, nothing to do if neither the row and actual column
   count have changed}
  if (aRowCount = RowCount) and (aActColCount = FActColCount) then
    Exit;
  {$IFDEF UseRangeChecks}
  {$IFDEF Windows}
  {In Delphi 1, range check total memory required}
  if (longint(aRowCount) * aActColCount * ItemSize > 65535) then
    raise Exception.Create(
             'TadTerminalArray.taGrowArray: product of rows, cols and item size is greater than 64KB');
  {$ENDIF}
  {$ENDIF}
  {at this point we must allocate another array}
  GetMem(NewArray, aRowCount * aActColCount * ItemSize);
  {blank it all out using the current default item}
  taClearRows(NewArray, aActColCount, 0, pred(aRowCount));
  {if the old array existed, transfer over the data, row by row,
   starting at the bottom}
  if (FItems <> nil) then begin
    {calculate the number of bytes to copy per row}
    if (ColCount < aColCount) then
      RowSize := ColCount * ItemSize
    else
      RowSize := aColCount * ItemSize;
    {calculate the number of rows to copy}
    if (RowCount < aRowCount) then
      NumRows := RowCount
    else
      NumRows := aRowCount;
    {copy the rows}
    FromPtr := @FItems[RowCount * FActColCount * ItemSize];
    ToPtr := @NewArray[aRowCount * aActColCount * ItemSize];
    for i := pred(RowCount) downto (RowCount - NumRows) do begin
      dec(FromPtr, FActColCount * ItemSize);
      dec(ToPtr, aActColCount * ItemSize);
      Move(FromPtr^, ToPtr^, RowSize);
    end;
    {dispose of the old array}
    FreeMem(FItems, RowCount * FActColCount * ItemSize);
  end;
  {save the new array}
  FItems := NewArray;
  FActColCount := aActColCount;
end;
{--------}
procedure TadTerminalArray.taSetColCount(aNewCount : integer);
begin
  {$IFDEF UseRangeChecks}
  {Range check aNewCount}
  if (aNewCount < 0) then
    raise Exception.Create(
             Format('TadTerminalArray.taSetColCount: new col count %d is less than zero',
                    [aNewCount]));
  {$ENDIF}
  if (aNewCount <> ColCount) then begin
    taGrowArray(RowCount, aNewCount, -1);
    FColCount := aNewCount;
  end;
end;
{--------}
procedure TadTerminalArray.taSetRowCount(aNewCount : integer);
begin
  {$IFDEF UseRangeChecks}
  {Range check aNewCount}
  if (aNewCount < 0) then
    raise Exception.Create(
             Format('TadTerminalArray.taSetColCount: new col count %d is less than zero',
                    [aNewCount]));
  {$ENDIF}
  if (aNewCount <> RowCount) then begin
    taGrowArray(aNewCount, ColCount, FActColCount);
    FRowCount := aNewCount;
  end;
end;
{--------}
procedure TadTerminalArray.WriteDupItems(aItem  : pointer;
                                         aCount : integer;
                                         aRow, aCol : integer);
var
  Walker    : PAnsiChar;
  Value     : longint;
  i         : integer;
  ItemCount : 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.WriteDupItems: either row %d or col %d is out of range',
                    [aRow, aCol]));
  {$ENDIF}
  if (FItems <> nil) then begin
    ItemCount := ColCount - aCol;
    if (ItemCount > aCount) then
      ItemCount := aCount;
    case ItemSize of
      1 : FillChar(FItems[(aRow * FActColCount) + aCol],
                   ItemCount, PByte(aItem)^);
      2 : begin
            Walker := @FItems[((aRow * FActColCount) + aCol) * 2];
            Value := PWord(aItem)^;
            for i := 0 to pred(ItemCount) do begin
              PWord(Walker)^ := Value;
              inc(Walker, 2);
            end;
          end;
      4 : begin
            Walker := @FItems[((aRow * FActColCount) + aCol) * 4];
            Value := PLongint(aItem)^;
            for i := 0 to pred(ItemCount) do begin
              PLongint(Walker)^ := Value;
              inc(Walker, 4);
            end;
          end;
    end;{case}
  end;
end;
{--------}
procedure TadTerminalArray.WriteItems(aItems : pointer;
                                      aCount : integer;
                                      aRow, aCol : integer);
var
  ItemCount : 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.WriteItems: either row %d or col %d is out of range',
                    [aRow, aCol]));
  {$ENDIF}
  if (FItems <> nil) then begin
    ItemCount := ColCount - aCol;
    if (ItemCount > aCount) then
      ItemCount := aCount;
    case ItemSize of
      1 : Move(aItems^,
               FItems[(aRow * FActColCount) + aCol],
               ItemCount);
      2 : Move(aItems^,
               FItems[(aRow * FActColCount * 2) + (aCol * 2)],
               ItemCount * 2);
      4 : Move(aItems^,
               FItems[(aRow * FActColCount * 4) + (aCol * 4)],
               ItemCount * 4);
    end;{case}
  end;
end;
{====================================================================}


{===Bitset routines==================================================}
procedure ADTClearAllBits(aBitset : PByteArray; aBitCount : integer);
begin
  FillChar(aBitset^, (aBitCount+7) shr 3, 0);
end;
{--------}
procedure ADTClearBit(aBitset : PByteArray; aBit : integer);
var
  BS : PAnsiChar absolute aBitset;
  P  : PAnsiChar;
  M  : byte;
begin
  P := BS + (aBit shr 3);