adterm.pas

测试用例

      StartTerminalPrim := CheckException(Self, Result)
    else
      StartTerminalPrim := Result;
  end;

  procedure TApdCustomTerminal.StartTerminal;
    {-Start terminal, assume ok to do so}
  begin
    StartTerminalPrim(True);
  end;

  function TApdCustomTerminal.StopTerminalPrim(UseExcept : Boolean) : Integer;
    {-Stop the terminal}
  begin
    if Assigned(FComPort) then
      if FComPort.Dispatcher <> nil then
        Result := SendMessage(Handle, APW_TERMSTOP, 0, 0)
      else
        Result := ecBadHandle
    else
      Result := ecPortNotAssigned;

    if UseExcept then
      StopTerminalPrim := CheckException(Self, Result)
    else
      StopTerminalPrim := Result;
  end;

  procedure TApdCustomTerminal.StopTerminal;
    {-Stop the terminal, assume ok to do so}
  begin
    CheckException(Self, SendMessage(Handle, APW_TERMSTOP, 0, 0));
  end;

  procedure TApdCustomTerminal.SetEmulator(
                               const NewEmulator : TApdCustomEmulator);
    {-Attach the emulator to the terminal}
  begin
    if FEmulator <> NewEmulator then begin
      if FEmulator <> nil then
        FEmulator.EmuInUse := False;
      FEmulator := NewEmulator;
      if (FEmulator <> nil) and (not FEmulator.EmuInUse) then begin
        SendMessage(Handle, APW_TERMSETEMUPROC, 0, LongInt(@EmulatorHook));
        SendMessage(Handle, APW_TERMSETEMUPTR, 0, LongInt(FEmulator));
        FEmulator.EmuInUse := True;
      end else begin
        SendMessage(Handle, APW_TERMSETEMUPROC, 0, 0);
        SendMessage(Handle, APW_TERMSETEMUPTR, 0, 0);
        FEmulator := nil;
      end;
    end;
  end;

  procedure TApdCustomTerminal.SetKeyboardEmu(
                               const NewKeyEmulator : TApdKeyboardEmulator);
    {-Attach the emulator to the terminal}
  begin
    if FKeyBoardEmu <> NewKeyEmulator then begin
      if FKeyboardEmu <> nil then
        FKeyboardEmu.KeyEmuInUse := False;
      FKeyboardEmu := NewKeyEmulator;
      if (FKeyboardEmu <> nil) and (not FKeyboardEmu.KeyEmuInUse) then begin
        SendMessage(Handle, APW_TERMSETKEYEMUPROC, 0, LongInt(@KeyboardHook));
        SendMessage(Handle, APW_TERMSETKEYEMUPTR, 0, LongInt(FKeyboardEmu));
        FKeyboardEmu.KeyEmuInUse := True;
      end else begin
        SendMessage(Handle, APW_TERMSETKEYEMUPROC, 0, 0);
        SendMessage(Handle, APW_TERMSETKEYEMUPTR, 0, 0);
        FKeyboardEmu := nil;
      end;
    end;
  end;

  procedure TApdCustomTerminal.SetName(const Value: TComponentName);
    {-If in design mode, stuff new data}
  var
    OldName : TComponentName;
  begin
    OldName := Name;
    inherited SetName(Value);

    if (csDesigning in ComponentState) and (OldName <> '') then
      StuffDesignData;
  end;

  procedure TApdCustomTerminal.WMSize(var Message: TWMSize);
    {-Update design data on resize}
  begin
    inherited;
    if (DisplayRows < 1) then
      DisplayRows := 1;
    if csDesigning in ComponentState then
      StuffDesignData;
  end;

  procedure TApdCustomTerminal.ResetTermBuffer;
  begin
    SendMessage(Handle, APW_TERMGETBUFFPTR, 0, LongInt(@TermBuff));
  end;

  procedure TApdCustomTerminal.PassFont;
    {-Tell the terminal window about the font change}
  var
    FontHandle : HFont;
  begin
    FontHandle := SendMessage(Handle, WM_SETFONT, Font.Handle, Longint(True));
    if FontHandle = 0 then begin
      {Terminal window rejected the font, switch back to default font}
      Font.Name := adtDefFontName;
      Font.Pitch := fpFixed;
      Font.Style := [];
      Font.Size  := 9;
    end;
  end;

  procedure TApdCustomTerminal.CMFontChanged(var Message : TMessage);
    {-Tell the terminal window about the font change}
  begin
    inherited;

    if Created then begin
      {Pass the font change along to the terminal window}
      PassFont;

      {See if we need a terminal size change}
      if csLoading in ComponentState then begin
        SetDisplayRows(FDisplayRows);
        SetDisplayColumns(FDisplayColumns);
      end;

      {Update the colors in case the font color changed}
      PassColors;

      {If designing, update the terminal window contents to show new color}
      if csDesigning in ComponentState then
        StuffDesignData;
    end;
  end;

  procedure TApdCustomTerminal.GetColorMap;
    {-Return the color map}
  begin
    SendMessage(Handle, APW_TERMCOLORMAP, gscGetMap, LongInt(@ColorMap));
  end;

  procedure TApdCustomTerminal.SetColorMap;
    {-Set a new color map}
  begin
    SendMessage(Handle, APW_TERMCOLORMAP, gscSetMap, LongInt(@ColorMap));
  end;

  procedure TApdCustomTerminal.PassColors;
    {-Pass colors to terminal window}
  var
    FC, BC : Integer;
    RGB : LongInt;
  begin
    {Move background color from terminal component to terminal window}
    RGB := ColorToRGB(Color);
    BC := ColorIndex(RGB);
    if BC = -1 then begin
      {Color not in map, stuff it in current background color slot}
      BC := CurrentColor(True);
      ColorMap[BC] := RGB;
      SetColorMap;
    end;

    {Move foreground color from font to terminal window}
    RGB := ColorToRGB(Font.Color);
    FC := ColorIndex(RGB);
    if FC = -1 then begin
      {Color not in map, stuff it in the current foreground color slot}
      FC := CurrentColor(False);
      ColorMap[FC] := RGB;
      SetColorMap;
    end;

    {Set new foreground/background colors (also sets highlight colors)}
    SetColors(FC, BC);
    ResetTermBuffer;
  end;

  procedure TApdCustomTerminal.CMColorChanged(var Message : TMessage);
    {-Tell terminal window that color changed}
  begin
    if Created then begin
      {Pass new colors to the terminal window}
      PassColors;

      {If designing, update the terminal window contents to show new color}
      if csDesigning in ComponentState then
        StuffDesignData;
    end;
    inherited;
  end;

  procedure TApdCustomTerminal.PortOpen(var Message : TMessage);
    {-Port was just opened, inform window procedure}
  begin
    CheckException(Self,
      SendMessage(Handle, APW_TERMSETCOM, ComPort.Dispatcher.handle, 0));
    if ActivePending then
      SetActive(True);
  end;

  procedure TApdCustomTerminal.PortClose(var Message : TMessage);
    {-Port was just closed, inform the window procedure}
  begin
    CheckException(Self, SendMessage(Handle, APW_TERMRELCOM, 0, 0));
    ActivePending := Active;
    Active := False;
  end;

  function TApdCustomTerminal.ColorIndex(const RGB : TColor) : Integer;
    {-Return an ANSI color index for RGB, -1 if not found}
  var
    I : Word;
  begin
    for I := emBlack to emWhiteBold do begin
      if LongInt(ColorMap[I]) = RGB then begin                       
        Result := I;
        Exit;
      end;
    end;
    Result := -1;
  end;

  function TApdCustomTerminal.CurrentColor(const Back : Boolean) : Integer;
    {-Return current foreground or background color index}
  var
    Colors : Longint;
  begin
    Colors := SendMessage(Handle, APW_TERMCOLORMAP, gscGetColors, 0);
    if Back then
      Result := LH(Colors).H
    else
      Result := LH(Colors).L
  end;

  procedure TApdCustomTerminal.SetIntegralSize(const NewInt : TIntegralSize);
    {-Adjust the window style long}
  begin
    if FIntegralSize <> NewInt then begin
      FIntegralSize := NewInt;
      RecreateWnd;
    end;
  end;

  procedure TApdCustomTerminal.SetScrollback(const NewScroll : Boolean);
    {-Set the scrollback mode}
  begin
    if FScrollback <> NewScroll then begin
      FScrollback := NewScroll;
      if FScrollback then begin
        WasFullWidth := DisplayColumns = Columns;
        PixelWidth := Width;
      end else if WasFullWidth then begin
        Force := True;
        if (IntegralSize = isNone) or (IntegralSize = isHeight) then
          Width := PixelWidth
        else
          DisplayColumns := FColumns;
        Force := False;
      end;
      SendMessage(Handle, APW_TERMTOGGLESCROLL, 0, 0);
    end;
  end;

  procedure TApdCustomTerminal.GetTermState;
    {-Note the current terminal state}
  begin
    TermSave := Pointer(SendMessage(Handle, APW_TERMSAVE, 0, 0));
  end;

  procedure TApdCustomTerminal.SetTermState;
    {-Restore the current terminal state}
  begin
    if TermSave <> nil then
      SendMessage(Handle, APW_TERMSAVE, 1, LongInt(TermSave));
  end;

  procedure TApdCustomTerminal.RecreateWnd;
    {-Recreate the window element}
  var
    WasActive : Boolean;
  begin
    if not (csLoading in ComponentState) then begin
      WasActive := Active;
      if Active then
        StopTerminalPrim(False);
      GetTermState;
      InRecreate := True;
      inherited RecreateWnd;
      InRecreate := False;
      SetTermState;
      if WasActive then
        StartTerminalPrim(False);
    end;
  end;

  procedure TApdCustomTerminal.WndProc(var Message: TMessage);
  begin
    case Message.Msg of
      WM_ERASEBKGND :
        ;
      WM_DESTROY :
        begin
          {Deregister ourselves from the port}
          if Assigned(FComPort) then
            ComPort.DeregisterUser(Handle);

          {Close capture file it one is open}
          if (FCapture = cmOn) or (FCapture = cmAppend) then
            SetCapture(cmOff);

          {The emulator is now free for another terminal window}
          if Assigned(FEmulator) then
            FEmulator.EmuInUse := False;

          if Assigned(FKeyboardEmu) then
            FKeyboardEmu.KeyEmuInUse := False;

        end;
      WM_MOUSEACTIVATE :
        if not (csDesigning in ComponentState) then
          inherited WndProc(Message);
      else
        inherited WndProc(Message);
    end;
  end;

  procedure TApdCustomTerminal.SetScrollBars(const NewScroll : TScrollStyle);
    {-Set the new scroll behavior}
  const
    ScrollBits : array[TScrollStyle] of LongInt =
                 (0, ws_HScroll, ws_VScroll, ws_HScroll or ws_VScroll);
  begin
    if NewScroll <> FScrollBars then begin
      {Update scrollbar bits}
      FScrollBars := NewScroll;

      {Deselect autoscroll for the specified scrollbars}
      if (NewScroll = ssBoth) or (NewScroll = ssHorizontal) then begin
        case FAutoScroll of
          asBoth       : FAutoScroll := asVertical;
          asHorizontal : FAutoScroll := asNone;
        end;
      end;
      if (NewScroll = ssBoth) or (NewScroll = ssVertical) then begin
        case FAutoScroll of
          asBoth     : FAutoScroll := asHorizontal;
          asVertical : FAutoScroll := asNone;
        end;
      end;

      {Recreate window element to show new scrollbar options}
      RecreateWnd;
    end;
  end;

  procedure TApdCustomTerminal.SetAutoScroll(const NewScroll : TAutoScroll);
    {-Set the new autoscroll behavior}
  begin
    if NewScroll <> FAutoScroll then begin
      FAutoScroll := NewScroll;

      {Recreate window element to show new scrollbar options}
      RecreateWnd;
    end;
  end;

  procedure TApdCustomTerminal.SetActive(const NewActive : Boolean);
    {-Start or stop terminal events}
  var
    Res : Integer;
  begin
    if (FActive <> NewActive) or ActivePending then begin
      if not (csDesigning in ComponentState) then begin
        if Assigned(FComPort) then begin
          {All okay, activate/deactivate the terminal window}
          if NewActive then begin
            Res := StartTerminalPrim(False);
            if Res = ecOk then
              ActivePending := False
            else begin
              ActivePending := True;
              FComPort.ForcePortOpen;
              Exit;
            end;
            FActive := True;
          end else begin
            {Deactivating terminal window}
            StopTerminalPrim(False);
            FActive := False;
          end;
        end else begin
          if NewActive then
            {Can't set active because port isn't assigned}
            CheckException(Self, ecPortNotAssigned)
          else
            {Not assigned but ok to set to False}
            FActive := False;
        end;
      end else
        {Designing, just set the property}
        FActive := NewActive;
    end;
  end;

  procedure TApdCustomTerminal.SetRows(const NewRows : Word);
    {-Set a new number of rows}
  begin
    if FRows <> NewRows then begin