adterm.pas

测试用例

      PKeyEmulator(FKeyEmuData)^.kbProcessAll := Bool(Value);
  end;
end;

function TApdCustomKeyBoardEmulator.GetProcessAll: Boolean;
begin
  Result := FKeyEmuProcessAllKeys;
end;

procedure TApdCustomKeyboardEmulator.SetProcessExt(const Value: Boolean);
begin
  if Value <> FKeyEmuProcessExtended then begin
    FKeyEmuProcessExtended := Value;
    if FKeyEmuData <> nil then
      PKeyEmulator(FKeyEmuData)^.kbProcessExt := Bool(Value);
  end;
end;

function TApdCustomKeyboardEmulator.GetProcessExt: Boolean;
begin
  Result := FKeyEmuProcessExtended;
end;

{TApdEmulator}

  constructor TApdCustomEmulator.Create(AOwner : TComponent);
    {-Create and initialize the emulator component}
  begin
    inherited Create(AOwner);

    {Inits}
    {$IFDEF AproBCB}
    FEmuData := nil;
    {$ELSE}
    FEmuData := adtDefEmuData;
    {$ENDIF}
    FEmuProc := nil;
    FEmulatorType := adtDefEmulatorType;
    FEmuInUse := False;
  end;

  destructor TApdCustomEmulator.Destroy;
  begin
    EmulatorType := etNone;
    inherited Destroy;
  end;

  procedure TApdCustomEmulator.SetEmulatorType(
                            const NewEmulatorType : TEmulatorType);
    {-Set a new emulator type}
  begin
    if NewEmulatorType <> FEmulatorType then begin
      {Get rid of old emulator}
      case FEmulatorType of
        etNone :
          ;
        etANSI..etANSIBBS :
          if EmuData <> nil then begin
            aeDoneAnsiEmulator(PAnsiEmulator(FEmuData));
            FEmuData := nil;
            FEmuProc := nil;
          end;
      end;

      {Create new emulator}
      FEmulatorType := NewEmulatorType;
      case FEmulatorType of
        etNone :
          EmuData := nil;
        etANSI..etANSIBBS :
          begin
            aeInitAnsiEmulator(PAnsiEmulator(FEmuData));
            PAnsiEmulator(FEmuData)^.emuType := Ord(NewEmulatorType);
            @FEmuProc := @aeProcessAnsiChar;
          end;
      end;
    end;
  end;

  procedure TApdCustomEmulator.SetEmuData(NewEmu : Pointer);
    {-Set new Emu data}
  begin
    if NewEmu <> FEmuData then begin
      FEmuData := NewEmu;
      EmulatorType := etNone;
    end;
  end;

  procedure TApdCustomEmulator.SetEmuProc(NewProc : TProcessCharProc);
    {-Set new EmuProc}
  begin
    if @NewProc <> @FEmuProc then begin
      FEmuProc := NewProc;
      EmulatorType := etNone;
    end;
  end;

  procedure TApdCustomEmulator.Loaded;
    {-Force setting of ANSI emulation}
  begin
    inherited Loaded;

    if FEmulatorType = etAnsi then begin
      FEmulatorType := etNone;
      EmulatorType := etAnsi;
    end;
  end;

  procedure TApdCustomEmulator.ProcessChar(C : Char; var Command : TEmuCommand);
    {-Call event handler}
  begin
    FOnProcessChar(Self, C, Command)
  end;

{TApdTerminal}

  constructor TApdCustomTerminal.Create(AOwner : TComponent);
    {-Create and initialize the terminal component}
  begin
    inherited Create(AOwner);

    {Inits}
    Force := False;
    Created := False;
    WasFullWidth := False;
    Width := adtDefWidth;
    Height := adtDefHeight;
    {$IFDEF AProBCB}                                              
    ControlStyle := [csClickEvents, csSetCaption, csFramed, csDoubleClicks];
    {$ELSE}
    ControlStyle := adtDefControlStyles;
    {$ENDIF}
    TabStop := adtDefTermTabStop;
    ParentColor := adtDefParentColor;
    ParentFont := adtDefParentFont;
    ActivePending := False;
    InRecreate := False;
    FStyle := adtDefStyle;
    FActive := adtDefActive;
    Color := adtDefColor;
    FScrollBars := adtDefScrollBars;
    FScrollback := adtDefScrollback;
    FIntegralSize := adtDefIntegralSize;
    FRows := adtDefRows;
    FColumns := adtDefColumns;
    FPageHeight := adtDefPageHeight;
    FDisplayRows := adtDefDisplayRows;
    FDisplayColumns := adtDefDisplayColumns;
    FCapture := adtDefCapture;
    FCaptureFile := adtDefCaptureFile;
    FKeyboardEmu := nil;
    {$IFDEF AProBCB}
    FComPort := nil;
    FEmulator := nil;
    TermSave := nil;
    {$ELSE}
    FComPort := adtDefComPort;
    FEmulator := adtDefEmulator;
    TermSave := adtDefTermSave;
    {$ENDIF}
    Font.Color := adtDefFontColor;
    Font.Name := adtDefFontName;
    Font.Size := 9;
    Font.Pitch := fpFixed;
    Font.Style := [];
    FBlinkTime := adtDefBlinkTime;
    FPersistentMark := adtDefPersistentMark;
    FHalfDuplex := adtDefHalfDuplex;
  end;

  procedure TApdCustomTerminal.CreateWnd;
    {-Search for an existing TComPort and assign if found}
  var
    OurForm    : TForm;
    OrigHeight : Word;
    OrigWidth  : Word;

    function FindComPort : TApdCustomComPort;
      {-Search for an existing TComPort}
    var
      I : Integer;
    begin
      Result := nil;
      for I := 0 to OurForm.ComponentCount-1 do begin
        if OurForm.Components[I] is TApdCustomComPort then begin
          Result := TApdCustomComPort(OurForm.Components[I]);
          Break;
        end;
      end;
    end;

    function FindEmulator : TApdCustomEmulator;
      {-Search for an existing TApdEmulator}
    var
      I : Integer;
    begin
      Result := nil;
      for I := 0 to OurForm.ComponentCount-1 do begin
        if OurForm.Components[I] is TApdCustomEmulator then begin
          Result := TApdCustomEmulator(OurForm.Components[I]);
          if Result.EmuInUse then
            Result := nil
          else
            Break;
        end;
      end;
    end;


    function FindKeyboard : TApdKeyboardEmulator;
      {-Search for an existing TApdEmulator}
    var
      I : Integer;
    begin
      Result := nil;
      for I := 0 to OurForm.ComponentCount-1 do begin
        if OurForm.Components[I] is TApdKeyboardEmulator then begin
          Result := TApdKeyboardEmulator(OurForm.Components[I]);
          if Result.KeyEmuInUse then
            Result := nil
          else
            Break;
        end;
      end;
    end;


  begin
    {Save height/width before creating window because the creation}
    {process will change them to the AWTERM defaults.             }
    OrigHeight := Height;
    OrigWidth  := Width;

    {Create the window element}
    inherited CreateWnd;
    Created := True;

    {Find the parent form}
    OurForm := TForm(GetParentForm(Self));

    {Search for comport and assign if found}
    if not Assigned(FComPort) then
      ComPort := FindComPort;

    {Search for emulator and assign if found}
    if not Assigned(FEmulator) then
      Emulator := FindEmulator;


    {Search for keyboard and assign if found}
    if not Assigned(FKeyboardEmu) then
      KeyBoardEmu := FindKeyboard;

    {Set the terminal window's font and color}
    GetColorMap;
    PassColors;
    PassFont;

    {Force the initial size}
    Force := True;
    SetHeight(OrigHeight);
    SetWidth(OrigWidth);
    SetDisplayRows(FDisplayRows);
    SetDisplayColumns(FDisplayColumns);
    Force := False;

    {Set options}
    SetWantTabs(adtDefWantTabs);

    if csDesigning in ComponentState then
      {Stuff with design data}
      StuffDesignData
    else
      {Clear buffer to initial colors}
      ClearBuffer;
  end;

  procedure TApdCustomTerminal.CreateParams(var Params : TCreateParams);
    {-Setup our window creation parameters}
  const
    ScrollBits : array[TScrollStyle] of DWORD =
                 (0, ws_HScroll, ws_VScroll, ws_HScroll + ws_VScroll);
    AutoBits : array[TAutoScroll] of DWORD =
               (0, tws_AutoHScroll, tws_AutoVScroll,
               tws_AutoHScroll + tws_AutoVScroll);
    IntegralBits : array[TIntegralSize] of DWORD =                    
                   (0, tws_IntWidth, tws_IntHeight,
                   tws_IntWidth + tws_IntHeight);
  begin
    inherited CreateParams(Params);

    if csDesigning in ComponentState then begin
      RegisterTerminalWindowClass(True);
      CreateSubClass(Params, TerminalClassNameDesign);
    end else begin
      RegisterTerminalWindowClass(False);
      CreateSubClass(Params, TerminalClassName);
    end;
    Params.Style := Params.Style or
                    AutoBits[FAutoScroll] or
                    ScrollBits[FScrollBars] or
                    IntegralBits[FIntegralSize];
  end;

  procedure TApdCustomTerminal.StuffDesignData;
    {-Stuff terminal with design data, assumes we're in design mode}
  var
    I : Word;
  begin
    ClearBuffer;
    for I := 1 to DisplayRows do begin
      StuffString(Name + ' - line ' + IntToStr(I));
      if I <> DisplayRows then
        StuffString(^M^J);
    end;
    Repaint;
  end;

  procedure TApdCustomTerminal.SetComPort(const NewComPort : TApdCustomComPort);
    {-Set a new comport, set or release handle}
  var
    OK : Boolean;
  begin
    if NewComPort <> FComPort then begin
      {Reregister from old comport}
      if Assigned(FComPort) then
        ComPort.DeregisterUser(Handle);

      FComPort := NewComPort;

      {Okay to try to activate?}
      if Assigned(FComPort) then begin
        ComPort.RegisterUser(Handle);
        OK := ComPort.Open or
              (ComPort.AutoOpen and not (csDesigning in ComponentState))
      end else
        OK := False;

      if OK then begin
        if Active or ActivePending then begin
          {Stop the current terminal, in case it is active...}
          StopTerminalPrim(False);
          {...and start the new one}
          StartTerminal;
          ActivePending := False;
        end else begin
          StopTerminalPrim(False);
          ActivePending := True;
        end;
      end else
        CheckException(Self, SendMessage(Handle, APW_TERMRELCOM, 0, 0));
    end;
  end;

  procedure TApdCustomTerminal.ClearWindow;
    {-Clear the window}
  begin
    CheckException(Self, SendMessage(Handle, APW_TERMCLEAR, 0, 0));
  end;

  procedure TApdCustomTerminal.ClearBuffer;
    {-Clear the entire buffer}
  begin
    CheckException(Self, SendMessage(Handle, APW_TERMCLEAR, 1, 0));
  end;

  procedure TApdCustomTerminal.StuffChar(const C : Char);
    {-Add C to the current location in the terminal window}
  begin
    CheckException(Self, SendMessage(Handle, APW_TERMSTUFF, 1, Longint(@C)));
  end;

  procedure TApdCustomTerminal.StuffString(const S : String);
    {-Add S to the current location in the terminal window}
  begin
    CheckException(Self, SendMessage(Handle, APW_TERMSTUFF,
                                     Length(S), Longint(@S[1])));
  end;

  procedure TApdCustomTerminal.ForcePaint;
    {-Force a screen update}
  begin
    CheckException(Self, SendMessage(Handle, APW_TERMPAINT, 0, 0));
  end;

  procedure TApdCustomTerminal.CopyToClipboard;
    {-Copy marked block to clipboard}
  begin
    CheckException(Self, SendMessage(Handle, WM_COPY, 0, 0));
  end;

  procedure TApdCustomTerminal.SetColors(const FC, BC : Byte);
    {-Set colors}
  begin
    CheckException(Self,
      SendMessage(Handle, APW_TERMCOLORS, FC, BC));
  end;

  function TApdCustomTerminal.StartTerminalPrim(UseExcept : Boolean) : Integer;
    {-Start terminal}
  begin
    {Try to start the terminal}
    if Assigned(FComPort) then begin
      if FComPort.Dispatcher <> nil then begin
        Result := SendMessage(Handle, APW_TERMSETCOM, FComPort.Dispatcher.Handle, 0);
        if Result = ecOk then
          Result := SendMessage(Handle, APW_TERMSTART, 1, 0);
      end else
        Result := ecBadHandle;
    end else
      Result := ecPortNotAssigned;

    {Return value or generate exception}
    if UseExcept then