adterm.pas

测试用例

    procedure SetCaptureFile(const NewFile : ShortString);
    procedure SetBlinkTime(const NewTime : Word);
    procedure SetPersistentMark(const NewMark : Boolean);
    procedure SetHalfDuplex(const NewDuplex : Boolean);
    procedure SetTermLine(Index: Word; NewLine: String);
    function  GetTermLine(Index: Word): String;
    {AttrLines property removed for BCB}
    {$IFNDEF AProBCB}
    procedure SetTermAttrLine(Index: Word; NewLine: TTermAttrLine);
    function  GetTermAttrLine(Index: Word): TTermAttrLine;
    {$ENDIF}
    {Event methods}
    procedure TerminalStatus(Row, Col : Byte; BufRow, BufCol : Word); virtual;
    procedure TerminalError(ErrorCode : Word); virtual;
    procedure CursorPosReport(XPos, YPos : Integer); virtual;

    {Message methods}
    procedure apwTermStatus(var Message : TMessage); message APW_TERMSTATUS;
    procedure apwTermError(var Message : TMessage);
      message APW_TERMERROR;
    procedure apwCursorPosReport(var Message : TMessage);
      message APW_CURSORPOSREPORT;

    {Other protected methods}
    procedure PassBuffer;
    procedure GetTermState;
    procedure SetTermState;
    procedure RecreateWnd;
    procedure WndProc(var Message: TMessage); override;
    procedure Notification(AComponent : TComponent;
                           Operation: TOperation); override;
    procedure Loaded; override;

   public
    {Creation/destruction}
    constructor Create(AOwner : TComponent); override;
      {-Create a TApdTerminal component}
    {.Z-}

    {Other public properties}
    procedure ClearWindow;
      {-Clear the visible window by performing a page-down operation}
    procedure ClearBuffer;
      {-Clear the entire buffer}
    procedure StuffChar(const C : Char);
      {-Add the character C to the current location in the terminal window}
    procedure StuffString(const S : String);
      {-Add the string S to the current location in the terminal window}
    procedure ForcePaint;
      {-Update the terminal display, required after StuffChar or StuffString}
    procedure CopyToClipboard;
      {-Copy the marked block to the clipboard}
    procedure SetColors(const FC, BC : Byte);
      {-Set the foreground and background colors for new data}
    function  ClientLine(Value: Word): Word;
      {-Return the actual buffer line # from the client line #}
    {Added for BCB since the AttrLines property was removed.}
    procedure SetTermAttrLineEx(Index: Word; NewLine: TTermAttrLine);
    procedure GetTermAttrLineEx(Index: Word; var Line : TTermAttrLine);

    property CharWidth : Byte
      read getCharWidth; {Changed to lower case 'g' for BCB}
    property CharHeight : Byte
      read getCharHeight; {Changed to lower case 'g' for BCB}  
    property Lines[Index: Word]: String
      read GetTermLine write SetTermLine;
    {AttrLines property removed for BCB}
    {$IFNDEF AProBCB}
    property AttrLines[Index: Word]: TTermAttrLine
      read GetTermAttrLine write SetTermAttrLine;
    {$ENDIF}

  public {published}
    property ComPort : TApdCustomComPort
      read FComPort write SetComPort;
    property Active : Boolean
      read FActive write SetActive default adtDefActive;
    property ScrollBars : TScrollStyle
      read FScrollBars write SetScrollBars default adtDefScrollBars;
    property AutoScroll : TAutoScroll
      read FAutoScroll write SetAutoScroll default adtDefAutoScroll;
    property IntegralSize : TIntegralSize
      read FIntegralSize write SetIntegralSize default adtDefIntegralSize;
    property Scrollback : Boolean
      read FScrollback write SetScrollback default adtDefScrollback;
    property Emulator : TApdCustomEmulator
      read FEmulator write SetEmulator;

    property Rows : Word
      read FRows write SetRows default adtDefRows;
    property Columns : Word
      read FColumns write SetColumns default adtDefColumns;
    property PageHeight : Word
      read FPageHeight write SetPageHeight default adtDefPageHeight;
    property DisplayRows : Word
      read GetDisplayRows write SetDisplayRows default adtDefDisplayRows;
    property DisplayColumns : Word
      read GetDisplayColumns write SetDisplayColumns default adtDefDisplayColumns;
    property CaptureFile : ShortString
      read FCaptureFile write SetCaptureFile;
    property Capture : TCaptureMode
      read FCapture write SetCapture default adtDefCapture;
    property WantTabs : Boolean
      read GetWantTabs write SetWantTabs default adtDefWantTabs;
    property BlinkTime : Word
      read FBlinkTime write SetBlinkTime;
    property PersistentMark : Boolean
      read FPersistentMark write SetPersistentMark;
    property HalfDuplex : Boolean
      read FHalfDuplex write SetHalfDuplex;
    property KeyBoardEmu : TApdKeyboardEmulator
      read FKeyBoardEmu write SetKeyboardEmu;

    {.Z+}
    {Override these so we can get to SetWidth/SetHeight}
    property Height : Integer
      read GetHeight write SetHeight;
    property Width : Integer
      read GetWidth write SetWidth;
    {.Z-}

    {Events}
    property OnTerminalStatus : TTerminalStatusEvent
      read FOnTerminalStatus write FOnTerminalStatus;
    property OnTerminalError : TTerminalErrorEvent
      read FOnTerminalError write FOnTerminalError;
    property OnCursorPosReport : TTerminalCursorPosReportEvent
      read FOnCursorPosReport write FOnCursorposReport;
  end;

  {The terminal window component}
  TApdTerminal = class(TApdCustomTerminal)
  published
    {Publish the terminal window properties}
    property ComPort;
    property Active;
    property ScrollBars;
    property AutoScroll;
    property IntegralSize;
    property Scrollback;
    property Emulator;
    property Rows;
    property Columns;
    property PageHeight;
    property DisplayRows;
    property DisplayColumns;
    property CaptureFile;
    property Capture;
    property WantTabs;
    property Height;
    property Width;
    property BlinkTime;
    property PersistentMark;
    property HalfDuplex;
    property KeyBoardEmu;
    property OnTerminalStatus;
    property OnTerminalError;
    property OnCursorPosReport;

    {Published inherited properties}
    property Align;
    property Color default adtDefColor;
    property Ctl3D;
    property Cursor;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property Visible;

    {Published inherited events}
    property OnClick;
    property OnDblClick;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

  {B+ Terminal}
(*  TApdCustomBPTerminal = class(TApdCustomTerminal)
  protected {private}
    {.Z+}
    TimerIndex    : Cardinal;         {B+ timer trigger handle}
    EnqTrig       : Cardinal;         {ENQ trigger handle}
    DLETrig       : Cardinal;         {DLE trigger handle}
    EscITrig      : Cardinal;         {<ESC>I trigger handle}
    Started       : Boolean;          {True if B+ started}
    ProcessingDLE : Boolean;          {True when processing a DLE sequence}
    Protocol      : TApdProtocol;     {B+ protocol component}
    FBPlusTriggers: Boolean;          {Sets triggers on/off}
    FOnBPlusStart : TNotifyEvent;     {Event handler for B+ starts}

  protected
    procedure SetBPlusTriggers(const OnOff : Boolean);
    procedure CreateWnd; override;
    procedure apwTriggerTimer(var Msg : TMessage); message APW_TRIGGERTIMER;
    procedure apwTriggerLength(var Msg : TMessage); message APW_TRIGGERAVAIL;
    procedure apwTriggerData(var Msg : TMessage); message APW_TRIGGERDATA;
    procedure apwBPlusStart(var Msg : TMessage); message APW_TERMBPLUSSTART;
    function FoundDLE : Boolean;
    procedure Notification(AComponent : TComponent;
                           Operation: TOperation); override;

  public
    constructor Create(AOwner : TComponent); override;
      {-Create a TApdBPTerminal}
    {.Z-}

    property OnBPlusStart : TNotifyEvent
      read FOnBPlusStart write FOnBPlusStart;
    property BPlusTriggers : Boolean
      read FBPlusTriggers write SetBPlusTriggers default adtDefBPlusTriggers;
  end;

  {B+ Terminal}
  TApdBPTerminal = class(TApdCustomBPTerminal)
  published
    property ComPort;
    property Active;
    property ScrollBars;
    property AutoScroll;
    property IntegralSize;
    property Scrollback;
    property Emulator;
    property Rows;
    property Columns;
    property PageHeight;
    property DisplayRows;
    property DisplayColumns;
    property CaptureFile;
    property Capture;
    property Align;
    property Color default adtDefColor;
    property Ctl3D;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property Visible;
    property WantTabs;
    property BlinkTime;
    property PersistentMark;
    property HalfDuplex;
    property KeyBoardEmu;
    property OnClick;
    property OnDblClick;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnBPlusStart;
    property OnTerminalError;
    property OnTerminalStatus;
    property OnCursorPosReport;
  end;*)

implementation


{Private types}
type
  TTermFontData = record
    Height : Byte;
    Width  : Byte;
    JIC    : Word;
  end;

{Global emulator hook}

  procedure EmulatorHook(P : PAnsiEmulator; C : Char;
                         var Command : TEmuCommand); far;
    {-Process this character}
  begin
    with TApdCustomEmulator(P) do begin
      if Assigned(FOnProcessChar) then
        ProcessChar(C, Command)
      else if @FEmuProc <> nil then
        TProcessCharProcLo(FEmuProc)(EmuData, C, TEmuCommandLo(Command))
      else begin
        Command.Ch := C;
        Command.Cmd := eChar;
      end;
    end;
  end;

  procedure KeyboardHook(P : PKeyEmulator; Key : Word;
                         var Command : TKeyEmuCommand); far;
    {-Process this key}
  begin
    with TApdCustomKeyboardEmulator(P) do begin
      if @FKeyEmuProc <> nil then
        TProcessKeyProcLo(FKeyEmuProc)(KeyEmuData, Key, TKeyEmuCommandLo(Command))
      else begin
        FillChar(Command, SizeOf(Command), #0);
        Command.KeyCode := Key;
        Command.Extended := False;
      end;
    end;
  end;

{-ApdCustomKeyboard-}

constructor TApdCustomKeyboardEmulator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FKeyEmuInUse           := False;
  FKeyEmuData            := nil;
  FKeyEmuProc            := nil;
  FEnabled               := DefKeyEmuEnabled;
  FKeyEmuType            := '';
  FKeyEmuFilename        := DefKeyEmuFileName;
  FKeyEmuProcessAllKeys  := DefKeyEmuProcessAll;
  FKeyEmuProcessExtended := DefKeyEmuProcessExtended;
  FKeyEmuTypeList        := TStringList.Create;
end;

destructor TApdCustomKeyboardEmulator.Destroy;
begin
  Enabled := False;
  FKeyEmuTypeList.Free;
  inherited Destroy;
end;

procedure TApdCustomKeyboardEmulator.SetEnabled(const Value: Boolean);
var
  TempFileName  : array[0..255] of char;
  TempIndex     : PChar;
begin
  if Value <> FEnabled then begin
    if Value then begin
      if CheckException(Self, kbInitKeyEmulator(PKeyEmulator(FKeyEmuData),
                              StrPCopy(TempFileName, FKeyEmuFileName))) = ecOK then begin
        @FKeyEmuProc := @kbProcessKey;
        FEnabled := Value;
        FKeyEmuTypeList.Clear;
        if kbNumEmuTypes(PKeyEmulator(FKeyEmuData)) > 1 then begin
          if CheckException(Self,
                kbLoadKeyEmuIndex(PKeyEmulator(FKeyEmuData))) = ecOK then begin
            TempIndex := PKeyEmulator(FKeyEmuData)^.kbKeyNameList;
            while (TempIndex^ <> #0) do begin
              FKeyEmuTypeList.Add(StrPas(TempIndex));
              Inc(TempIndex, StrLen(TempIndex) + 1);
            end;
            EmulatorType := FKeyEmuTypeList[0];
          end;
        end;
      end;
    end else begin
      if FKeyEmuData <> nil then
        kbDoneKeyEmulator(PKeyEmulator(FKeyEmuData));
      FKeyEmuData := nil;
      FKeyEmuProc := nil;
      FEnabled := Value;
      FKeyEmuTypeList.Clear;
      EmulatorType := '';
    end;
  end;
end;

procedure TApdCustomKeyboardEmulator.SetKeyEmuType(const Value: String);
var
  Temp : TKeyMapName;
begin
  if Value <> FKeyEmuType then begin
    FKeyEmuType := Value;
    if FKeyEmuData <> nil then
      if not (csDesigning in ComponentState) then begin
        kbSetKeyEmuType(PKeyEmulator(FKeyEmuData), StrPCopy(Temp, Value));
        CheckException(Self, kbLoadKeyEmuMap(PKeyEmulator(FKeyEmuData)));
      end;
  end;
end;

procedure TApdCustomKeyboardEmulator.SetFileName(const Value: String);
begin
  if FKeyEmuFileName <> Value then begin
    FKeyEmuFileName := Value;
    if FEnabled then begin
      Enabled := False;
      Enabled := True;
    end;
  end;
end;

procedure TApdCustomKeyboardEmulator.SetKeyEmuData(const NewKeyEmu : Pointer);
  {-Set new Emu data}
begin
  if NewKeyEmu <> FKeyEmuData then begin
    FKeyEmuData := NewKeyEmu;
  end;
end;

procedure TApdCustomKeyboardEmulator.SetKeyEmuProc(const NewKeyProc : TProcessKeyProc);
  {-Set new EmuProc}
begin
  if @NewKeyProc <> @FKeyEmuProc then begin
    FKeyEmuProc := NewKeyProc;
  end;
end;

procedure TApdCustomKeyboardEmulator.SetProcessAll(const Value: Boolean);
begin
  if Value <> FKeyEmuProcessAllKeys then begin
    FKeyEmuProcessAllKeys := Value;
    if FKeyEmuData <> nil then