adterm.pas

测试用例

      if NewRows < PageHeight then
        FRows := PageHeight
      else
        FRows := NewRows;
      if Longint(Rows) * Columns > 65535 then
        FColumns := 65535 div Rows;
      PassBuffer;
    end;
  end;

  procedure TApdCustomTerminal.SetColumns(const NewColumns : Word);
    {-Set a new number of columns}
  begin
    if FColumns <> NewColumns then begin
      if NewColumns < FDisplayColumns then                        
        FColumns := FDisplayColumns
      else FColumns := NewColumns;
      if Longint(Rows) * Columns > 65535 then
        FRows := 65535 div Columns;
      PassBuffer;
    end;
  end;

  procedure TApdCustomTerminal.SetPageHeight(const NewPageHeight : Word);
    {-Set a new page height}
  begin
    if FPageHeight <> NewPageHeight then begin
      if NewPageHeight > Rows then
        FPageHeight := Rows
      else                                                         
        FPageHeight := NewPageHeight;
      PassBuffer;
    end;
  end;

  function TApdCustomTerminal.GetDisplayRows : Word;
    {-Return number of display rows}
  begin
    FDisplayRows := ClientHeight div CharHeight;
    Result := FDisplayRows;
  end;

  procedure TApdCustomTerminal.SetDisplayRows(const NewRows : Word);
    {-Set a new display height; always updates, even if no change}
  begin
    if (IntegralSize = isBoth) or (IntegralSize = isHeight) then begin
      if NewRows > PageHeight then
        FDisplayRows := PageHeight
      else
        FDisplayRows := NewRows;
      SendMessage(Handle, APW_TERMFORCESIZE, FDisplayColumns, FDisplayRows);
      ResetTermBuffer;
    end;
  end;

  function TApdCustomTerminal.GetDisplayColumns : Word;
    {-Return the number of display columns}
  begin
    FDisplayColumns := ClientWidth div CharWidth;
    Result := FDisplayColumns;
  end;

  procedure TApdCustomTerminal.SetDisplayColumns(const NewColumns : Word);
    {-Set a new display width; always updates, even if no change}
  begin
    if (IntegralSize = isBoth) or (IntegralSize = isWidth) then begin
      if NewColumns > Columns then
        FDisplayColumns := Columns
      else
        FDisplayColumns := NewColumns;
      SendMessage(Handle, APW_TERMFORCESIZE, FDisplayColumns, FDisplayRows);
    end;
  end;

  function TApdCustomTerminal.GetWantTabs : Boolean;
    {-Return WantTabs option}
  begin
    Result := (GetWindowLong(Handle, gwl_Style) and tws_WantTab) <> 0;
  end;

  procedure TApdCustomTerminal.SetWantTabs(const NewTabs : Boolean);
    {-Set new WantTabs option}
  var
    Style : Longint;
  begin
    Style := GetWindowLong(Handle, gwl_Style);
    if NewTabs then
      SetWindowLong(Handle, gwl_Style, Style or tws_WantTab)
    else
      SetWindowLong(Handle, gwl_Style, Style and not tws_WantTab);
  end;

  function TApdCustomTerminal.GetHeight : Integer;
    {-Get the height in pixels}
  begin
    Result := inherited Height;
  end;

  procedure TApdCustomTerminal.SetHeight(const NewHeight : Integer);
    {-Set height in pixels if sbPixels}
  begin
    if (IntegralSize = isNone) or
       (IntegralSize = isWidth) or
       (csLoading in ComponentState) then
      {It's valid to change Height...}
      if (NewHeight <> Height) or Force then
        {...and it really needs to be changed}
        inherited Height := NewHeight;
  end;

  function TApdCustomTerminal.GetWidth : Integer;
    {-Get the width in pixels}
  begin
    Result := inherited Width;
  end;

  procedure TApdCustomTerminal.SetWidth(const NewWidth : Integer);
    {-Set width in pixels if sbPixels}
  begin
    if (IntegralSize = isNone) or
       (IntegralSize = isHeight) or
       (csLoading in ComponentState) then
      {It's valid to change width...}
      if (NewWidth <> Width) or Force then
        {...and it really needs to be changed}
        inherited Width := NewWidth;
  end;

  procedure TApdCustomTerminal.SetBlinkTime(const NewTime : Word);
    {-Set the time interval for blinking characters}
  begin
    if FBlinkTime <> NewTime then begin
      FBlinkTime := NewTime;
      SendMessage(Handle, apw_TermBlinkTimeChange, NewTime, 0);
    end;
  end;

  procedure TApdCustomTerminal.SetPersistentMark(const NewMark: Boolean);
    {-Set the the terminal marking to be either persistent no not}
  begin
    if FPersistentMark <> NewMark then begin
      FPersistentMark := NewMark;
      SendMessage(Handle, apw_TermPersistentMarkChange, Ord(NewMark), 0);
    end;
  end;

  procedure TApdCustomTerminal.SetHalfDuplex(const NewDuplex: Boolean);
    {-Set the the terminal half/full duplex mode}
  begin
    if FHalfDuplex <> NewDuplex then begin
      FHalfDuplex := NewDuplex;
      SendMessage(Handle, apw_TermSetHalfDuplex, Ord(NewDuplex), 0);
    end;
  end;

  function TApdCustomTerminal.ClientLine(Value: Word): Word;
  begin
    if Value = 0 then
      Value := 1;
    if Value > FDisplayRows then
      raise EBadArgument.Create(ecBadArgument, False)
    else
      Result := SendMessage(Handle, APW_TERMGETCLIENTLINE, 0, 0) + Value;
  end;

  procedure TApdCustomTerminal.SetTermLine(Index: Word; NewLine: String);
  var
    TempLine : array[0..MaxCols-1] of char;
    TempAttr : TTermAttrLine;
    TempXAttr: TTermAttrLine;
    LineNum  : Word;
    TempColor: Byte;
  begin
    if Index = 0 then
      Index := 1;
    if (Longint(Index) * Columns > 65535) or
       (Index > Rows) or
       (Index < 1) then                                          
      raise EBadArgument.Create(ecBadArgument, False)
    else if TermBuff.Data <> nil then begin
      LineNum := Columns*(Index-1);
      while Length(NewLine) < Columns do
        NewLine := NewLine + ' ';
      StrPCopy(TempLine, NewLine);

      {-Set the color to the first color in the line}
      {Changed from property to GetTermAttrLineEx() for BCB.}
      {$IFNDEF AProBCB}
      TempAttr := AttrLines[Index];
      {$ELSE}
      GetTermAttrLineEx(Index, TempAttr);
      {$ENDIF}
      TempColor := TempAttr[0];
      if TempColor = 0 then
        TempColor := 7;       {white on black}
      FillChar(TempAttr, SizeOf(TempAttr), TempColor);

      {Turn off all extended attributes}
      FillChar(TempXAttr, SizeOf(TempXAttr), 0);

      {replace the old data with the new}
      Move(TempLine, TermBuff.Data^[LineNum], Columns);
      Move(TempAttr, TermBuff.Attr^[LineNum], Columns);
      Move(TempXAttr, TermBuff.XAttr^[LineNum], Columns);

      {-Redisplay the terminal}
      InvalidateRect(Handle, nil, False);
      UpdateWindow(Handle);
    end;
  end;

  function TApdCustomTerminal.GetTermLine(Index: Word): String;
  var
    TempLine : array[0..MaxCols] of char;
  begin
    if (Longint(Index) * Columns > 65535) or
       (Index > Rows) or
       (Index < 1) then                                          
      raise EBadArgument.Create(ecBadArgument, False)
    else if TermBuff.Data <> nil then begin
      FillChar(TempLine, SizeOf(TempLine), #0);
      Move(TermBuff.Data^[Columns*(Index-1)], TempLine, Columns);
      Result := StrPas(TempLine);
    end;
  end;

  {$IFNDEF AProBCB}
  procedure TApdCustomTerminal.SetTermAttrLine(Index: Word; NewLine: TTermAttrLine);
  var
    TempXAttr: TTermAttrLine;
    LineNum  : Word;
  begin
    if Index = 0 then
      Index := 1;
    if (Longint(Index) * Columns > 65535) or
       (Index > Rows) or
       (Index < 1) then                                          
      raise EBadArgument.Create(ecBadArgument, False)
    else if TermBuff.Attr <> nil then begin
      LineNum := Columns*(Index-1);

      {Turn off all extended attributes}
      FillChar(TempXAttr, SizeOf(TempXAttr), 0);

      {replace the old data with the new}
      Move(NewLine, TermBuff.Attr^[LineNum], Columns);
      Move(TempXAttr, TermBuff.XAttr^[LineNum], Columns);

      {-Redisplay the terminal}
      InvalidateRect(Handle, nil, False);
      UpdateWindow(Handle);
    end;
  end;

  function TApdCustomTerminal.GetTermAttrLine(Index: Word): TTermAttrLine;
  var
    TempLine : TTermAttrLine;
  begin
    if (Longint(Index) * Columns > 65535) or
       (Index > Rows) or
       (Index < 1) then                                           
      raise EBadArgument.Create(ecBadArgument, False)
    else if TermBuff.Attr <> nil then begin
      Move(TermBuff.Attr^[Columns*(Index-1)], TempLine, Columns);
      Result := TempLine;
    end;
  end;
  {$ENDIF}

  procedure TApdCustomTerminal.SetTermAttrLineEx(Index: Word; NewLine: TTermAttrLine);
  var
    TempXAttr: TTermAttrLine;
    LineNum  : Word;
  begin
    if Index = 0 then
      Index := 1;
    if (Longint(Index) * Columns > 65535) or
       (Index > Rows) or
       (Index < 1) then                                            
      raise EBadArgument.Create(ecBadArgument, False)
    else if TermBuff.Attr <> nil then begin
      LineNum := Columns*(Index-1);

      {Turn off all extended attributes}
      FillChar(TempXAttr, SizeOf(TempXAttr), 0);

      {replace the old data with the new}
      Move(NewLine, TermBuff.Attr^[LineNum], Columns);
      Move(TempXAttr, TermBuff.XAttr^[LineNum], Columns);

      {-Redisplay the terminal}
      InvalidateRect(Handle, nil, False);
      UpdateWindow(Handle);
    end;
  end;

  procedure TApdCustomTerminal.GetTermAttrLineEx(Index: Word; var Line : TTermAttrLine);
  begin
    if (Longint(Index) * Columns > 65535) or
       (Index > Rows) or
       (Index < 1) then                                         
      raise EBadArgument.Create(ecBadArgument, False)
    else if TermBuff.Attr <> nil then begin
      Move(TermBuff.Attr^[Columns*(Index-1)], Line, Columns);
    end;
  end;

  function TApdCustomTerminal.getCharWidth : Byte;
    {-Return the current character width, in pixels}
  var
    FD : TTermFontData;
  begin
    Longint(FD) := SendMessage(Handle, APW_TERMFONTSIZE, 0, 0);
    Result := FD.Width;
  end;

  function TApdCustomTerminal.getCharHeight : Byte;
    {-Return the current character height, in pixels}
  var
    FD : TTermFontData;
  begin
    Longint(FD) := SendMessage(Handle, APW_TERMFONTSIZE, 0, 0);
    Result := FD.Height;
  end;

  procedure TApdCustomTerminal.SetCapture(const NewCapture : TCaptureMode);
    {-Turn capturing on/off}
  var
    CapAppend : Boolean;
    Enable    : Boolean;
    P : array[0..255] of Char;
  begin
    if FCapture <> NewCapture then begin
      FCapture := NewCapture;
      if not (csDesigning in ComponentState) and not InRecreate then begin
        StrPCopy(P, FCaptureFile);
        Enable := (NewCapture = cmOn) or (NewCapture = cmAppend);
        CapAppend := NewCapture = cmAppend;
        CheckException(Self, SendMessage(Handle, APW_TERMCAPTURE,
                             (Ord(CapAppend) shl 8) or Ord(Enable),
                             LongInt(@P)));
      end;
    end;
  end;

  procedure TApdCustomTerminal.SetCaptureFile(const NewFile : ShortString);
    {-Set new capture file name}
  var
    OldCapture : TCaptureMode;
  begin
    if CompareText(FCaptureFile, NewFile) <> 0 then begin
      if (FCapture = cmOn) or (FCapture = cmAppend) then begin
        OldCapture := FCapture;
        SetCapture(cmOff);
        FCaptureFile := NewFile;
        SetCapture(OldCapture);
      end else
        FCaptureFile := NewFile;
    end;
  end;

  procedure TApdCustomTerminal.TerminalStatus(Row, Col : Byte;
                                           BufRow, BufCol : Word);
    {-Call the user's event handler}
  begin
    if Assigned(FOnTerminalStatus) then
      FOnTerminalStatus(Self, Row, Col, BufRow, BufCol);
  end;

  procedure TApdCustomTerminal.apwTermStatus(var Message : TMessage);
    {-Receives apw_TermStatus message from terminal}
  begin
    with Message do
      {$IFDEF WIN32}
      TerminalStatus(Lo(wParamLo), Hi(wParamLo), lParamLo, lParamHi); 
      {$ELSE}
      TerminalStatus(wParamLo, wParamHi, lParamLo, lParamHi);
      {$ENDIF}
  end;

  procedure TApdCustomTerminal.TerminalError(ErrorCode: Word);
    {-Call the user's event handler}
  begin
    if Assigned(FOnTerminalError) then
      FOnTerminalError(Self, ErrorCode);
  end;

  procedure TApdCustomTerminal.apwTermError(var Message : TMessage);
    {-Receives apw_TermError message from terminal}
  begin
    with Message do begin
      TerminalError(wParamLo);
      if lParam = 0 then
        Capture := cmOff;
    end;                                                             
  end;

  procedure TApdCustomTerminal.CursorPosReport(XPos, YPos : Integer);
    {-Call the user's event handler}
  begin
    if Assigned(FOnCursorPosReport) then
      FOnCursorPosReport(Self, XPos, YPos);
  end;

  procedure TApdCustomTerminal.apwCursorPosReport(var Message : TMessage);
    {-Receives apw_CursorPosReport message from terminal}
  begin
    with Message do
      CursorPosReport(wParamLo, lParamLo);
  end;

  procedure TApdCu