{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclConsole.pas.                                                             }
{                                                                                                  }
{ The Initial Developer of the Original Code is Flier Lu. Portions created by Flier Lu are         }
{ Copyright (C) Flier Lu. All Rights Reserved.                                                     }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Flier Lu (flier)                                                                               }
{   Robert Marquardt (marquardt)                                                                   }
{   Robert Rossmair (rrossmair)                                                                    }
{   Petr Vones (pvones)                                                                            }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ This unit contains classes and routines to support windows Character-Mode Applications           }
{                                                                                                  }
{ Unit owner: Flier Lu                                                                             }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/05/05 20:08:47 $
// For history see end of file

unit JclConsole;

{$I jcl.inc}
{$I windowsonly.inc}

{$HPPEMIT 'namespace JclConsole'}
(*$HPPEMIT '{'*)
{$HPPEMIT '__interface IJclScreenTextAttribute;'}
(*$HPPEMIT '}'*)
{$HPPEMIT 'using namespace JclConsole;'}
{$HPPEMIT ''}

interface

uses
  Windows,
  Classes, SysUtils, Contnrs,
  JclBase;

// Console
type
  TJclScreenBuffer = class;
  TJclInputBuffer = class;

  TJclConsole = class(TObject)
  private
    FScreens: TObjectList;
    FActiveScreenIndex: Longword;
    FInput: TJclInputBuffer;
    FOnCtrlC: TNotifyEvent;
    FOnCtrlBreak: TNotifyEvent;
    FOnClose: TNotifyEvent;
    FOnLogOff: TNotifyEvent;
    FOnShutdown: TNotifyEvent;
    function GetScreen(const Idx: Longword): TJclScreenBuffer;
    function GetScreenCount: Longword;
    function GetActiveScreen: TJclScreenBuffer;
    procedure SetActiveScreen(const Value: TJclScreenBuffer);
    procedure SetActiveScreenIndex(const Value: Longword);
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    function GetInputCodePage: DWORD;
    function GetOutputCodePage: DWORD;
    procedure SetInputCodePage(const Value: DWORD);
    procedure SetOutputCodePage(const Value: DWORD);
  protected
    constructor Create;
  public
    destructor Destroy; override;
    class function Default: TJclConsole;
    class procedure Shutdown;
    { TODO : Add 'Attach' and other functions for WinXP/Win.Net }
    {$IFNDEF CLR}
    class function IsConsole(const Module: HMODULE): Boolean; overload;
    class function IsConsole(const FileName: TFileName): Boolean; overload;
    {$ENDIF ~CLR}
    class function MouseButtonCount: DWORD;
    class procedure Alloc;
    class procedure Free;
    function Add(AWidth: Smallint = 0; AHeight: Smallint = 0): TJclScreenBuffer;
    function Remove(const ScrBuf: TJclScreenBuffer): Longword;
    procedure Delete(const Idx: Longword);
    property Title: string read GetTitle write SetTitle;
    property InputCodePage: DWORD read GetInputCodePage write SetInputCodePage;
    property OutputCodePage: DWORD read GetOutputCodePage write SetOutputCodePage;
    property Input: TJclInputBuffer read FInput;
    property Screens[const Idx: Longword]: TJclScreenBuffer read GetScreen;
    property ScreenCount: Longword read GetScreenCount;
    property ActiveScreenIndex: Longword read FActiveScreenIndex write SetActiveScreenIndex;
    property ActiveScreen: TJclScreenBuffer read GetActiveScreen write SetActiveScreen;
    property OnCtrlC: TNotifyEvent read FOnCtrlC write FOnCtrlC;
    property OnCtrlBreak: TNotifyEvent read FOnCtrlBreak write FOnCtrlBreak;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnLogOff: TNotifyEvent read FOnLogOff write FOnLogOff;
    property OnShutdown: TNotifyEvent read FOnShutdown write FOnShutdown;
  end;

  TJclConsoleInputMode = (imLine, imEcho, imProcessed, imWindow, imMouse);
  TJclConsoleInputModes = set of TJclConsoleInputMode;
  TJclConsoleOutputMode = (omProcessed, omWrapAtEol);
  TJclConsoleOutputModes = set of TJclConsoleOutputMode;

  IJclScreenTextAttribute = interface;
  TJclScreenFont = class;
  TJclScreenCharacter = class;
  TJclScreenCursor = class;
  TJclScreenWindow = class;

  // Console screen buffer
  TJclScreenBufferBeforeResizeEvent = procedure(Sender: TObject; const NewSize: TCoord; var CanResize: Boolean) of object;
  TJclScreenBufferAfterResizeEvent = procedure(Sender: TObject) of object;

  TJclScreenBufferTextHorizontalAlign = (thaCurrent, thaLeft, thaCenter, thaRight);
  TJclScreenBufferTextVerticalAlign = (tvaCurrent, tvaTop, tvaCenter, tvaBottom);

  TJclScreenBuffer = class(TObject)
  private
    FHandle: THandle;
    FFont: TJclScreenFont;
    FCursor: TJclScreenCursor;
    FWindow: TJclScreenWindow;
    FCharList: TObjectList;
    FOnAfterResize: TJclScreenBufferAfterResizeEvent;
    FOnBeforeResize: TJclScreenBufferBeforeResizeEvent;
    function GetInfo: TConsoleScreenBufferInfo;
    function GetSize: TCoord;
    procedure SetSize(const Value: TCoord);
    function GetHeight: Smallint;
    function GetWidth: Smallint;
    procedure SetHeight(const Value: Smallint);
    procedure SetWidth(const Value: Smallint);
    function GetMode: TJclConsoleOutputModes;
    procedure SetMode(const Value: TJclConsoleOutputModes);
  protected
    constructor Create; overload;
    constructor Create(const AHandle: THandle); overload;
    constructor Create(const AWidth, AHeight: Smallint); overload;
    procedure Init;
    procedure DoResize(const NewSize: TCoord); overload;
    procedure DoResize(const NewWidth, NewHeight: Smallint); overload;
    property Info: TConsoleScreenBufferInfo read GetInfo;
  public
    destructor Destroy; override;
    function Write(const Text: string;
      const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload;
    function Writeln(const Text: string = '';
      const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload;
    function Write(const Text: string; const X: Smallint; const Y: Smallint;
      const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload;
    {$IFDEF CLR}
    function Write(const Text: string; const X: Smallint; const Y: Smallint;
      Attrs: array of Word): DWORD; overload;
    {$ELSE}
    function Write(const Text: string; const X: Smallint; const Y: Smallint;
      pAttrs: PWORD): DWORD; overload;
    {$ENDIF CLR}
    function Write(const Text: string;
      const HorizontalAlign: TJclScreenBufferTextHorizontalAlign;
      const VerticalAlign: TJclScreenBufferTextVerticalAlign = tvaCurrent;
      const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload;
    function Read(const Count: Integer): string; overload;
    function Read(X: Smallint; Y: Smallint; const Count: Integer): string; overload;
    function Readln: string; overload;
    function Readln(X: Smallint; Y: Smallint): string; overload;
    procedure Fill(const ch: Char; const ATextAttribute: IJclScreenTextAttribute = nil);
    procedure Clear;
    property Handle: THandle read FHandle;
    property Font: TJclScreenFont read FFont;
    property Cursor: TJclScreenCursor read FCursor;
    property Window: TJclScreenWindow read FWindow;
    property Size: TCoord read GetSize write SetSize;
    property Width: Smallint read GetWidth write SetWidth;
    property Height: Smallint read GetHeight write SetHeight;
    property Mode: TJclConsoleOutputModes read GetMode write SetMode;
    property OnBeforeResize: TJclScreenBufferBeforeResizeEvent read FOnBeforeResize write FOnBeforeResize;
    property OnAfterResize: TJclScreenBufferAfterResizeEvent read FOnAfterResize write FOnAfterResize;
  end;

  // Console screen text attributes
  TJclScreenFontColor = (fclBlack, fclBlue, fclGreen, fclRed, fclCyan, fclMagenta, fclYellow, fclWhite);
  TJclScreenBackColor = (bclBlack, bclBlue, bclGreen, bclRed, bclCyan, bclMagenta, bclYellow, bclWhite);
  TJclScreenFontStyle = (fsLeadingByte, fsTrailingByte, fsGridHorizontal, fsGridLeftVertical, fsGridRightVertical, fsReverseVideo, fsUnderscore, fsSbcsDbcs);
  TJclScreenFontStyles = set of TJclScreenFontStyle;

  IJclScreenTextAttribute = interface
    ['{B880B1AC-9F1A-4F42-9D44-EA482B4F3510}']
    function GetTextAttribute: Word;
    procedure SetTextAttribute(const Value: Word);

    property TextAttribute: Word read GetTextAttribute write SetTextAttribute;

    function GetColor: TJclScreenFontColor;
    procedure SetColor(const Value: TJclScreenFontColor);
    function GetBgColor: TJclScreenBackColor;
    procedure SetBgColor(const Value: TJclScreenBackColor);
    function GetHighlight: Boolean;
    procedure SetHighlight(const Value: Boolean);
    function GetBgHighlight: Boolean;
    procedure SetBgHighlight(const Value: Boolean);
    function GetStyle: TJclScreenFontStyles;
    procedure SetStyle(const Value: TJclScreenFontStyles);

    property Color: TJclScreenFontColor read GetColor write SetColor;
    property BgColor: TJclScreenBackColor read GetBgColor write SetBgColor;
    property Highlight: Boolean read GetHighlight write SetHighlight;
    property BgHighlight: Boolean read GetBgHighlight write SetBgHighlight;
    property Style: TJclScreenFontStyles read GetStyle write SetStyle;
  end;

  TJclScreenCustomTextAttribute = class(TInterfacedObject, IJclScreenTextAttribute)
  private
    function GetBgColor: TJclScreenBackColor;
    function GetBgHighlight: Boolean;
    function GetColor: TJclScreenFontColor;
    function GetHighlight: Boolean;
    function GetStyle: TJclScreenFontStyles;
    procedure SetBgColor(const Value: TJclScreenBackColor);
    procedure SetBgHighlight(const Value: Boolean);
    procedure SetColor(const Value: TJclScreenFontColor);
    procedure SetHighlight(const Value: Boolean);
    procedure SetStyle(const Value: TJclScreenFontStyles);
  protected
    function GetTextAttribute: Word; virtual; abstract;
    procedure SetTextAttribute(const Value: Word); virtual; abstract;
  public
    constructor Create(const Attr: TJclScreenCustomTextAttribute = nil); overload;
    procedure Clear;
    property TextAttribute: Word read GetTextAttribute write SetTextAttribute;
    property Color: TJclScreenFontColor read GetColor write SetColor;
    property BgColor: TJclScreenBackColor read GetBgColor write SetBgColor;
    property Highlight: Boolean read GetHighlight write SetHighlight;
    property BgHighlight: Boolean read GetBgHighlight write SetBgHighlight;
    property Style: TJclScreenFontStyles read GetStyle write SetStyle;
  end;

  TJclScreenFont = class(TJclScreenCustomTextAttribute)
  private
    FScreenBuffer: TJclScreenBuffer;
  protected
    constructor Create(const AScrBuf: TJclScreenBuffer);
    function GetTextAttribute: Word; override;
    procedure SetTextAttribute(const Value: Word); override;
  public
    property ScreenBuffer: TJclScreenBuffer read FScreenBuffer;
  end;

  TJclScreenTextAttribute = class(TJclScreenCustomTextAttribute)
  private
    FAttribute: Word;
  protected
    function GetTextAttribute: Word; override;
    procedure SetTextAttribute(const Value: Word); override;
  public
    constructor Create(const Attribute: Word); overload;
    constructor Create(const AColor: TJclScreenFontColor = fclWhite;
      const ABgColor: TJclScreenBackColor = bclBlack;
      const AHighLight: Boolean = False;
      const ABgHighLight: Boolean = False;
      const AStyle: TJclScreenFontStyles = []); overload;
  end;

  TJclScreenCharacter = class(TJclScreenCustomTextAttribute)
  private
    FCharInfo: TCharInfo;
    function GetCharacter: Char;
    procedure SetCharacter(const Value: Char);
  protected
    constructor Create(const CharInfo: TCharInfo);
    function GetTextAttribute: Word; override;
    procedure SetTextAttribute(const Value: Word); override;
  public
    property Info: TCharInfo read FCharInfo write FCharInfo;
    property Character: Char read GetCharacter write SetCharacter;
  end;

  TJclScreenCursorSize = 1..100;

  TJclScreenCursor = class(TObject)
  private
    FScreenBuffer: TJclScreenBuffer;
    function GetInfo: TConsoleCursorInfo;
    procedure SetInfo(const Value: TConsoleCursorInfo);
    function GetPosition: TCoord;
    procedure SetPosition(const Value: TCoord);
    function GetSize: TJclScreenCursorSize;
    procedure SetSize(const Value: TJclScreenCursorSize);
    function GetVisible: Boolean;
    procedure SetVisible(const Value: Boolean);
  protected
    constructor Create(const AScrBuf: TJclScreenBuffer);
    property Info: TConsoleCursorInfo read GetInfo write SetInfo;
  public
    property ScreenBuffer: TJclScreenBuffer read FScreenBuffer;
    procedure MoveTo(const DestPos: TCoord); overload;
    procedure MoveTo(const x, y: Smallint); overload;
    procedure MoveBy(const Delta: TCoord); overload;
    procedure MoveBy(const cx, cy: Smallint); overload;
    property Position: TCoord read GetPosition write SetPosition;
    property Size: TJclScreenCursorSize read GetSize write SetSize;
    property Visible: Boolean read GetVisible write SetVisible;
  end;

  // Console screen window
  TJclScreenWindow = class(TObject)
  private
    FScreenBuffer: TJclScreenBuffer;
    function GetMaxConsoleWindowSize: TCoord;
    function GetMaxWindow: TCoord;
    function GetLeft: Smallint;
    function GetTop: Smallint;
    function GetWidth: Smallint;
    function GetHeight: Smallint;
    function GetPosition: TCoord;
    function GetSize: TCoord;
    function GetBottom: Smallint;
    function GetRight: Smallint;
    procedure SetLeft(const Value: Smallint);
    procedure SetTop(const Value: Smallint);
    procedure SetWidth(const Value: Smallint);
    procedure SetHeight(const Value: Smallint);
    procedure SetPosition(const Value: TCoord);
    procedure SetSize(const Value: TCoord);
    procedure SetBottom(const Value: Smallint);
    procedure SetRight(const Value: Smallint);
    procedure InternalSetPosition(const X, Y: SmallInt);
    procedure InternalSetSize(const X, Y: SmallInt);
  protected
    constructor Create(const AScrBuf: TJclScreenBuffer);
    procedure DoResize(const NewRect: TSmallRect; bAbsolute: Boolean = True);
  public
    procedure Scroll(const cx, cy: Smallint);
    property ScreenBuffer: TJclScreenBuffer read FScreenBuffer;
    property MaxConsoleWindowSize: TCoord read GetMaxConsoleWindowSize;
    property MaxWindow: TCoord read GetMaxWindow;
    property Position: TCoord read GetPosition write SetPosition;
    property Size: TCoord read GetSize write SetSize;
    property Left: Smallint read GetLeft write SetLeft;
    property Right: Smallint read GetRight write SetRight;
    property Top: Smallint read GetTop write SetTop;
    property Bottom: Smallint read GetBottom write SetBottom;
    property Width: Smallint read GetWidth write SetWidth;
    property Height: Smallint read GetHeight write SetHeight;
  end;

  // Console input buffer
  TJclInputCtrlEvent = ( ceCtrlC, ceCtrlBreak, ceCtrlClose, ceCtrlLogOff, ceCtrlShutdown );

  TJclInputRecordArray = array of TInputRecord;

  TJclInputBuffer = class(TObject)
  private
    FConsole: TJclConsole;
    FHandle: THandle;
    function GetMode: TJclConsoleInputModes;
    procedure SetMode(const Value: TJclConsoleInputModes);
    function GetEventCount: DWORD;
  protected
    constructor Create(const AConsole: TJclConsole);
  public
    destructor Destroy; override;
    procedure Clear;
    procedure RaiseCtrlEvent(const AEvent: TJclInputCtrlEvent; const ProcessGroupId: DWORD = 0);
    function WaitEvent(const TimeOut: DWORD = INFINITE): Boolean;
    function GetEvents(var Events: TJclInputRecordArray): DWORD; overload;
    function GetEvents(const Count: Integer): TJclInputRecordArray; overload;
    function PeekEvents(var Events: TJclInputRecordArray): DWORD; overload;
    function PeekEvents(const Count: Integer): TJclInputRecordArray; overload;
    function PutEvents(const Events: TJclInputRecordArray): DWORD; overload;
    function GetEvent: TInputRecord;
    function PeekEvent: TInputRecord;
    function PutEvent(const Event: TInputRecord): Boolean;
    property Console: TJclConsole read FConsole;
    property Handle: THandle read FHandle;
    property Mode: TJclConsoleInputModes read GetMode write SetMode;
    property EventCount: DWORD read GetEventCount;
  end;

implementation

uses
  {$IFDEF FPC}
  WinSysUt, JwaWinNT,
  {$ENDIF FPC}
  {$IFDEF CLR}
  System.Text,
  {$ENDIF CLR}
  Math, TypInfo,
  JclFileUtils, JclResources;

{$IFDEF FPC}
{$EXTERNALSYM CreateConsoleScreenBuffer}
const
  kernel32 = 'kernel32.dll';
  
function CreateConsoleScreenBuffer(dwDesiredAccess, dwShareMode: DWORD;
  lpSecurityAttributes: PSecurityAttributes; dwFlags: DWORD; lpScreenBufferData: Pointer): THandle; stdcall;
  external kernel32 name 'CreateConsoleScreenBuffer';
function SetConsoleWindowInfo(hConsoleOutput: THandle; bAbsolute: BOOL;
  const lpConsoleWindow: TSmallRect): BOOL; stdcall;
  external kernel32 name 'SetConsoleWindowInfo';
{$ENDIF FPC}

const
  COMMON_LVB_LEADING_BYTE    = $0100; // Leading Byte of DBCS
  COMMON_LVB_TRAILING_BYTE   = $0200; // Trailing Byte of DBCS
  COMMON_LVB_GRID_HORIZONTAL = $0400; // DBCS: Grid attribute: top horizontal.
  COMMON_LVB_GRID_LVERTICAL  = $0800; // DBCS: Grid attribute: left vertical.
  COMMON_LVB_GRID_RVERTICAL  = $1000; // DBCS: Grid attribute: right vertical.
  COMMON_LVB_REVERSE_VIDEO   = $4000; // DBCS: Reverse fore/back ground attribute.
  COMMON_LVB_UNDERSCORE      = $8000; // DBCS: Underscore.

  COMMON_LVB_SBCSDBCS        = $0300; // SBCS or DBCS flag.

const
  FontColorMask: Word = FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED;
  BackColorMask: Word = BACKGROUND_BLUE or BACKGROUND_GREEN or BACKGROUND_RED;
  FontStyleMask: Word = COMMON_LVB_LEADING_BYTE or COMMON_LVB_TRAILING_BYTE or
    COMMON_LVB_GRID_HORIZONTAL or COMMON_LVB_GRID_LVERTICAL or COMMON_LVB_GRID_RVERTICAL or
    COMMON_LVB_REVERSE_VIDEO or COMMON_LVB_UNDERSCORE or COMMON_LVB_SBCSDBCS;

  FontColorMapping: array [TJclScreenFontColor] of Word =
   (0,
    FOREGROUND_BLUE,
    FOREGROUND_GREEN,
    FOREGROUND_RED,
    FOREGROUND_BLUE or FOREGROUND_GREEN,
    FOREGROUND_BLUE or FOREGROUND_RED,
    FOREGROUND_GREEN or FOREGROUND_RED,
    FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED);

  BackColorMapping: array [TJclScreenBackColor] of Word =
   (0,
    BACKGROUND_BLUE,
    BACKGROUND_GREEN,
    BACKGROUND_RED,
    BACKGROUND_BLUE or BACKGROUND_GREEN,
    BACKGROUND_BLUE or BACKGROUND_RED,
    BACKGROUND_GREEN or BACKGROUND_RED,
    BACKGROUND_BLUE or BACKGROUND_GREEN or BACKGROUND_RED);

  FontStyleMapping: array [TJclScreenFontStyle] of Word =
   (COMMON_LVB_LEADING_BYTE,    // Leading Byte of DBCS
    COMMON_LVB_TRAILING_BYTE,   // Trailing Byte of DBCS
    COMMON_LVB_GRID_HORIZONTAL, // DBCS: Grid attribute: top horizontal.
    COMMON_LVB_GRID_LVERTICAL,  // DBCS: Grid attribute: left vertical.
    COMMON_LVB_GRID_RVERTICAL,  // DBCS: Grid attribute: right vertical.
    COMMON_LVB_REVERSE_VIDEO,   // DBCS: Reverse fore/back ground attribute.
    COMMON_LVB_UNDERSCORE,      // DBCS: Underscore.
    COMMON_LVB_SBCSDBCS);       // SBCS or DBCS flag.

const
  InputModeMapping: array [TJclConsoleInputMode] of DWORD =
    (ENABLE_LINE_INPUT, ENABLE_ECHO_INPUT, ENABLE_PROCESSED_INPUT,
     ENABLE_WINDOW_INPUT, ENABLE_MOUSE_INPUT);

  OutputModeMapping: array [TJclConsoleOutputMode] of DWORD =
    (ENABLE_PROCESSED_OUTPUT, ENABLE_WRAP_AT_EOL_OUTPUT);

var
  g_DefaultConsole: TJclConsole = nil;

function CtrlHandler(CtrlType: DWORD): BOOL; {$IFNDEF CLR} stdcall; {$ENDIF ~CLR}
var
  Console: TJclConsole;
begin
  try
    Console := TJclConsole.Default;
    Result := True;
    case CtrlType of
      CTRL_C_EVENT:
        if Assigned(Console.OnCtrlC) then
          Console.OnCtrlC(Console);
      CTRL_BREAK_EVENT:
        if Assigned(Console.OnCtrlBreak) then
          Console.OnCtrlBreak(Console);
      CTRL_CLOSE_EVENT:
        if Assigned(Console.OnClose) then
          Console.OnClose(Console);
      CTRL_LOGOFF_EVENT:
        if Assigned(Console.OnLogOff) then
          Console.OnLogOff(Console);
      CTRL_SHUTDOWN_EVENT:
        if Assigned(Console.OnShutdown) then
          Console.OnShutdown(Console);
    else
      // (rom) disabled. Makes function result unpredictable.
      //Assert(False, 'Unknown Ctrl Event');
      Result := False;
    end;
  except
    // (rom) dubious. An exception implies that an event has been handled.
    Result := False;
  end;
end;

//=== { TJclConsole } ========================================================

constructor TJclConsole.Create;
begin
  inherited Create;
  FScreens := TObjectList.Create;
  FInput:= TJclInputBuffer.Create(Self);
  FActiveScreenIndex := FScreens.Add(TJclScreenBuffer.Create);
  FOnCtrlC := nil;
  FOnCtrlBreak := nil;
  FOnClose := nil;
  FOnLogOff := nil;
  FOnShutdown := nil;
  SetConsoleCtrlHandler(@CtrlHandler, True);
end;

destructor TJclConsole.Destroy;
begin
  // (rom) why as first line?
  inherited Destroy;
  SetConsoleCtrlHandler(@CtrlHandler, False);
  FreeAndNil(FInput);
  FreeAndNil(FScreens);
end;

class procedure TJclConsole.Alloc;
begin
  Win32Check(AllocConsole);
end;

class procedure TJclConsole.Free;
begin
  Win32Check(FreeConsole);
end;

function TJclConsole.GetScreen(const Idx: Longword): TJclScreenBuffer;
begin
  // (rom) maybe some checks on Idx here?
  Result := TJclScreenBuffer(FScreens[Idx]);
end;

function TJclConsole.GetScreenCount: Longword;
begin
  Result := FScreens.Count;
end;

function TJclConsole.GetActiveScreen: TJclScreenBuffer;
begin
  Result := Screens[FActiveScreenIndex];
end;

procedure TJclConsole.SetActiveScreen(const Value: TJclScreenBuffer);
begin
  SetActiveScreenIndex(FScreens.IndexOf(Value));
end;

procedure TJclConsole.SetActiveScreenIndex(const Value: Longword);
begin
  if ActiveScreenIndex <> Value then
  begin
    Win32Check(SetConsoleActiveScreenBuffer(Screens[Value].Handle));
    FActiveScreenIndex := Value;
  end;
end;

class function TJclConsole.Default: TJclConsole;
begin
  if not Assigned(g_DefaultConsole) then
    g_DefaultConsole := TJclConsole.Create;
  Result := g_DefaultConsole;
end;

class procedure TJclConsole.Shutdown;
begin
  FreeAndNil(g_DefaultConsole);
end;

function TJclConsole.Add(AWidth, AHeight: Smallint): TJclScreenBuffer;
begin
  if AWidth = 0 then
    AWidth := ActiveScreen.Size.X;
  if AHeight = 0 then
    AHeight := ActiveScreen.Size.Y;
  Result := TJclScreenBuffer(FScreens[FScreens.Add(TJclScreenBuffer.Create(AWidth, AHeight))]);
end;

function TJclConsole.Remove(const ScrBuf: TJclScreenBuffer): Longword;
begin
  Result := FScreens.IndexOf(ScrBuf);
  Delete(Result);
end;

procedure TJclConsole.Delete(const Idx: Longword);
begin
  FScreens.Delete(Idx);
end;

function TJclConsole.GetTitle: string;
var
  Len: Integer;
begin
  { TODO : max 64kByte instead of max 255 }
  {$IFDEF CLR}
  { TODO : CLR TJclConsole.GetTitle }
  SetLength(Result, High(Byte));
  Len := GetConsoleTitle(Result, Length(Result));
  Win32Check((0 < Len) and (Len < Length(Result)));
  SetLength(Result, Len);
  {$ELSE}
  { TODO : max 64kByte instead of max 255 }
  SetLength(Result, High(Byte));
  Len := GetConsoleTitle(PChar(Result), Length(Result));
  Win32Check((0 < Len) and (Len < Length(Result)));
  SetLength(Result, Len);
  {$ENDIF CLR}
end;

procedure TJclConsole.SetTitle(const Value: string);
begin
  {$IFDEF CLR}
  Win32Check(SetConsoleTitle(Value));
  {$ELSE}
  Win32Check(SetConsoleTitle(PChar(Value)));
  {$ENDIF CLR}
end;

function TJclConsole.GetInputCodePage: DWORD;
begin
  Result := GetConsoleCP;
end;

procedure TJclConsole.SetInputCodePage(const Value: DWORD);
begin
  { TODO -cTest : SetConsoleCP under Win9x }
  Win32Check(SetConsoleCP(Value));
end;

function TJclConsole.GetOutputCodePage: DWORD;
begin
  Result := GetConsoleOutputCP;
end;

procedure TJclConsole.SetOutputCodePage(const Value: DWORD);
begin
  { TODO -cTest : SetConsoleOutputCP under Win9x }
  Win32Check(SetConsoleOutputCP(Value));
end;

{$IFNDEF CLR}
class function TJclConsole.IsConsole(const Module: HMODULE): Boolean;
begin
  Result := False;
  { TODO : Documentation of this solution }
  with PImageDosHeader(Module)^ do
  if e_magic = IMAGE_DOS_SIGNATURE then
    with PImageNtHeaders(Integer(Module) + {$IFDEF FPC} e_lfanew {$ELSE} _lfanew {$ENDIF})^ do
      if Signature = IMAGE_NT_SIGNATURE then
        Result := OptionalHeader.Subsystem = IMAGE_SUBSYSTEM_WINDOWS_CUI;
end;

class function TJclConsole.IsConsole(const FileName: TFileName): Boolean;
begin
  with TJclFileMappingStream.Create(FileName) do
  try
    Result := IsConsole(HMODULE(Memory));
  finally
    Free;
  end;
end;
{$ENDIF ~CLR}

class function TJclConsole.MouseButtonCount: DWORD;
begin
  Win32Check(GetNumberOfConsoleMouseButtons(Result));
end;

//=== { TJclScreenBuffer } ===================================================

constructor TJclScreenBuffer.Create;
begin
  inherited Create;
  FHandle := CreateFile('CONOUT$', GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  Win32Check(FHandle <> INVALID_HANDLE_VALUE);
  Init;
end;

constructor TJclScreenBuffer.Create(const AHandle: THandle);
begin
  inherited Create;
  FHandle := AHandle;
  Assert(FHandle <> INVALID_HANDLE_VALUE);
  Init;
end;

constructor TJclScreenBuffer.Create(const AWidth, AHeight: Smallint);
begin
  inherited Create;
  FHandle := CreateConsoleScreenBuffer(GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CONSOLE_TEXTMODE_BUFFER, nil);
  Win32Check(FHandle <> INVALID_HANDLE_VALUE);
  Init;
  DoResize(AWidth, AHeight);
end;

destructor TJclScreenBuffer.Destroy;
begin
  // (rom) why as first line?
  inherited Destroy;
  FreeAndNil(FFont);
  FreeAndNil(FCursor);
  FreeAndNil(FWindow);
  FreeAndNil(FCharList);
  CloseHandle(FHandle);
end;

procedure TJclScreenBuffer.Init;
begin
  FCharList := TObjectList.Create;
  FOnAfterResize := nil;
  FOnBeforeResize := nil;
  FFont := TJclScreenFont.Create(Self);
  FCursor := TJclScreenCursor.Create(Self);
  FWindow := TJclScreenWindow.Create(Self);
end;

function TJclScreenBuffer.GetInfo: TConsoleScreenBufferInfo;
begin
  Win32Check(GetConsoleScreenBufferInfo(FHandle, Result));
end;

function TJclScreenBuffer.GetSize: TCoord;
begin
  Result := Info.dwSize;
end;

procedure TJclScreenBuffer.SetSize(const Value: TCoord);
begin
  DoResize(Value);
end;

function TJclScreenBuffer.GetWidth: Smallint;
begin
  Result := Size.X;
end;

procedure TJclScreenBuffer.SetWidth(const Value: Smallint);
begin
  DoResize(Value, Size.Y);
end;

function TJclScreenBuffer.GetHeight: Smallint;
begin
  Result := Size.Y;
end;

procedure TJclScreenBuffer.SetHeight(const Value: Smallint);
begin
  DoResize(Size.X, Value);
end;

procedure TJclScreenBuffer.DoResize(const NewSize: TCoord);
var
  CanResize: Boolean;
begin
  if (Size.X <> NewSize.X) or (Size.Y <> NewSize.Y) then
  begin
    if Assigned(FOnBeforeResize) then
    begin
      CanResize := True;
      FOnBeforeResize(Self, NewSize, CanResize);
      if not CanResize then
        Exit;
    end;
    Win32Check(SetConsoleScreenBufferSize(FHandle, NewSize));
    if Assigned(FOnAfterResize) then
      FOnAfterResize(Self);
  end;
end;

procedure TJclScreenBuffer.DoResize(const NewWidth, NewHeight: Smallint);
var
  NewSize: TCoord;
begin
  NewSize.X := NewWidth;
  NewSize.Y := NewHeight;
  DoResize(NewSize);
end;

function TJclScreenBuffer.GetMode: TJclConsoleOutputModes;
var
  OutputMode: DWORD;
  AMode: TJclConsoleOutputMode;
begin
  Result := [];
  Win32Check(GetConsoleMode(FHandle, OutputMode));
  for AMode := Low(TJclConsoleOutputMode) to High(TJclConsoleOutputMode) do
    if (OutputMode and OutputModeMapping[AMode]) = OutputModeMapping[AMode] then
      Include(Result, AMode);
end;

procedure TJclScreenBuffer.SetMode(const Value: TJclConsoleOutputModes);
var
  OutputMode: DWORD;
  AMode: TJclConsoleOutputMode;
begin
  OutputMode := 0;
  for AMode := Low(TJclConsoleOutputMode) to High(TJclConsoleOutputMode) do
    if AMode in Value then
      OutputMode := OutputMode or OutputModeMapping[AMode];
  Win32Check(SetConsoleMode(FHandle, OutputMode));
end;

function TJclScreenBuffer.Write(const Text: string;
  const ATextAttribute: IJclScreenTextAttribute): DWORD;
begin
  if Assigned(ATextAttribute) then
    Font.TextAttribute := ATextAttribute.TextAttribute;
  {$IFDEF CLR}
  Win32Check(WriteConsole(Handle, StringToByteArray(Text), Text.Length, Result, nil));
  {$ELSE}
  Win32Check(WriteConsole(Handle, PChar(Text), Length(Text), Result, nil));
  {$ENDIF CLR}
end;

function TJclScreenBuffer.Writeln(const Text: string;
  const ATextAttribute: IJclScreenTextAttribute): DWORD;
begin
  Result := Write(Text, ATextAttribute);
  Cursor.MoveTo(Window.Left, Cursor.Position.Y + 1);
end;

function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint;
  const ATextAttribute: IJclScreenTextAttribute): DWORD;
var
  I: Integer;
  Pos: TCoord;
  Attrs: array of Word;
begin
  if Length(Text) > 0 then
  begin
    if (X = -1) or (Y = -1) then
    begin
      Pos := Cursor.Position;
    end
    else
    begin
      Pos.X := X;
      Pos.Y := Y;
    end;

    if Assigned(ATextAttribute) then
    begin
      SetLength(Attrs, Length(Text));
      for I:=0 to Length(Text)-1 do
        Attrs[I] := ATextAttribute.TextAttribute;
      {$IFDEF CLR}
      Result := Write(Text, X, Y, Attrs);
      {$ELSE}
      Result := Write(Text, X, Y, @Attrs[0]);
      {$ENDIF CLR}
    end
    else
      {$IFDEF CLR}
      Win32Check(WriteConsoleOutputCharacter(Handle, Text, Length(Text), Pos, Result));
      {$ELSE}
      Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result));
      {$ENDIF CLR}
  end
  else
    Result := 0;
end;

{$IFDEF CLR}
function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint;
  Attrs: array of Word): DWORD;
var
  Pos: TCoord;
begin
  if (X = -1) or (Y = -1) then
  begin
    Pos := Cursor.Position;
  end
  else
  begin
    Pos.X := X;
    Pos.Y := Y;
  end;
  if Length(Attrs) > 0 then
    Win32Check(WriteConsoleOutputAttribute(Handle, Attrs, Length(Text), Pos, Result));
  Win32Check(WriteConsoleOutputCharacter(Handle, Text, Length(Text), Pos, Result));
end;
{$ELSE}
function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint;
  pAttrs: PWORD): DWORD;
var
  Pos: TCoord;
begin
  if (X = -1) or (Y = -1) then
  begin
    Pos := Cursor.Position;
  end
  else
  begin
    Pos.X := X;
    Pos.Y := Y;
  end;
  if pAttrs <> nil then
    Win32Check(WriteConsoleOutputAttribute(Handle, pAttrs, Length(Text), Pos, Result));
  Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result));
end;
{$ENDIF CLR}

function TJclScreenBuffer.Write(const Text: string;
  const HorizontalAlign: TJclScreenBufferTextHorizontalAlign;
  const VerticalAlign: TJclScreenBufferTextVerticalAlign;
  const ATextAttribute: IJclScreenTextAttribute): DWORD;
var
  X, Y: Smallint;
begin
  case HorizontalAlign of
    //thaCurrent: X := Cursor.Position.X;
    thaLeft:
      X := Window.Left;
    thaCenter:
      X := Window.Left + (Window.Width - Length(Text)) div 2;
    thaRight:
      X := Window.Right - Length(Text) + 1;
  else
    X := Cursor.Position.X;
  end;
  case VerticalAlign of
    //tvaCurrent: Y := Cursor.Position.Y;
    tvaTop:
      Y := Window.Top;
    tvaCenter:
      Y := Window.Top + Window.Height div 2;
    tvaBottom:
      Y := Window.Bottom;
  else
    Y := Cursor.Position.Y;
  end;
  Result := Write(Text, X, Y, ATextAttribute);
end;

function TJclScreenBuffer.Read(const Count: Integer): string;
var
  ReadCount: DWORD;
  {$IFDEF CLR}
  Data: array of Byte;
  {$ENDIF CLR}
begin
  SetLength(Result, Count);
  {$IFDEF CLR}
  SetLength(Data, Count);
  Win32Check(ReadConsole(Handle, Data, Count, ReadCount, nil));
  Result := ByteArrayToString(Data, Min(ReadCount, ByteArrayStringLen(Data)));
  {$ELSE}
  Win32Check(ReadConsole(Handle, PChar(Result), Count, ReadCount, nil));
  SetLength(Result, Min(ReadCount, StrLen(PChar(Result))));
  {$ENDIF CLR}
end;

function TJclScreenBuffer.Readln: string;
begin
  Result := Read(Window.Right - Cursor.Position.X + 1);
end;

function TJclScreenBuffer.Read(X, Y: Smallint; const Count: Integer): string;
var
  ReadPos: TCoord;
  ReadCount: DWORD;
  {$IFDEF CLR}
  sb: System.Text.StringBuilder;
  {$ENDIF CLR}
begin
  ReadPos.X := X;
  ReadPos.Y := Y;
  SetLength(Result, Count);
  {$IFDEF CLR}
  sb := System.Text.StringBuilder.Create(Count);
  Win32Check(ReadConsoleOutputCharacter(Handle, sb, Count, ReadPos, ReadCount));
  Result := sb.ToString();
  {$ELSE}
  Win32Check(ReadConsoleOutputCharacter(Handle, PChar(Result), Count, ReadPos, ReadCount));
  SetLength(Result, Min(ReadCount, StrLen(PChar(Result))));
  {$ENDIF CLR}
end;

function TJclScreenBuffer.Readln(X, Y: Smallint): string;
begin
  Result := Read(X, Y, Window.Right - X + 1);
end;

procedure TJclScreenBuffer.Fill(const ch: Char; const ATextAttribute: IJclScreenTextAttribute);
var
  WriteCount: DWORD;
begin
  Cursor.MoveTo(0, 0);
  Win32Check(FillConsoleOutputCharacter(Handle, ch, Width * Height, Cursor.Position, WriteCount));
  if Assigned(ATextAttribute) then
    Win32Check(FillConsoleOutputAttribute(Handle, ATextAttribute.TextAttribute, Width * Height, Cursor.Position, WriteCount))
  else
    Win32Check(FillConsoleOutputAttribute(Handle, Font.TextAttribute, Width * Height, Cursor.Position, WriteCount));
end;

procedure TJclScreenBuffer.Clear;
begin
  Fill(' ', TJclScreenTextAttribute.Create(fclWhite, bclBlack, False, False, []));
end;

//=== { TJclScreenCustomTextAttribute } ======================================

constructor TJclScreenCustomTextAttribute.Create(const Attr: TJclScreenCustomTextAttribute);
begin
  inherited Create;
  if Assigned(Attr) then
    SetTextAttribute(Attr.GetTextAttribute);
end;

function TJclScreenCustomTextAttribute.GetColor: TJclScreenFontColor;
var
  TA: Word;
begin
  TA := TextAttribute and FontColorMask;
  for Result := High(TJclScreenFontColor) downto Low(TJclScreenFontColor) do
    if (TA and FontColorMapping[Result]) = FontColorMapping[Result] then
      Break;
end;

function TJclScreenCustomTextAttribute.GetBgColor: TJclScreenBackColor;
var
  TA: Word;
begin
  TA := TextAttribute and BackColorMask;
  for Result := High(TJclScreenBackColor) downto Low(TJclScreenBackColor) do
    if (TA and BackColorMapping[Result]) = BackColorMapping[Result] then
      Break;
end;

function TJclScreenCustomTextAttribute.GetHighlight: Boolean;
begin
  Result := (TextAttribute and FOREGROUND_INTENSITY) = FOREGROUND_INTENSITY;
end;

function TJclScreenCustomTextAttribute.GetBgHighlight: Boolean;
begin
  Result := (TextAttribute and BACKGROUND_INTENSITY) = BACKGROUND_INTENSITY;
end;

procedure TJclScreenCustomTextAttribute.SetColor(const Value: TJclScreenFontColor);
begin
  TextAttribute := (TextAttribute and (not FontColorMask)) or FontColorMapping[Value];
end;

procedure TJclScreenCustomTextAttribute.SetBgColor(const Value: TJclScreenBackColor);
begin
  TextAttribute := (TextAttribute and (not BackColorMask)) or BackColorMapping[Value];
end;

procedure TJclScreenCustomTextAttribute.SetHighlight(const Value: Boolean);
begin
  if Value then
    TextAttribute := TextAttribute or FOREGROUND_INTENSITY
  else
    TextAttribute := TextAttribute and (not FOREGROUND_INTENSITY);
end;

procedure TJclScreenCustomTextAttribute.SetBgHighlight(const Value: Boolean);
begin
  if Value then
    TextAttribute := TextAttribute or BACKGROUND_INTENSITY
  else
    TextAttribute := TextAttribute and (not BACKGROUND_INTENSITY);
end;

function TJclScreenCustomTextAttribute.GetStyle: TJclScreenFontStyles;
var
  ta: Word;
  AStyle: TJclScreenFontStyle;
begin
  Result := [];
  ta := TextAttribute and FontStyleMask;
  for AStyle := Low(TJclScreenFontStyle) to High(TJclScreenFontStyle) do
    if (ta and FontStyleMapping[AStyle]) = FontStyleMapping[AStyle] then
      Include(Result, AStyle);
end;

procedure TJclScreenCustomTextAttribute.SetStyle(const Value: TJclScreenFontStyles);
var
  ta: Word;
  AStyle: TJclScreenFontStyle;
begin
  ta := 0;
  for AStyle := Low(TJclScreenFontStyle) to High(TJclScreenFontStyle) do
    if AStyle in Value then
      ta := ta or FontStyleMapping[AStyle];
  TextAttribute := (TextAttribute and (not FontStyleMask)) or ta;
end;

procedure TJclScreenCustomTextAttribute.Clear;
begin
  TextAttribute := FontColorMapping[fclWhite] or BackColorMapping[bclBlack];
end;

//=== { TJclScreenFont } =====================================================

constructor TJclScreenFont.Create(const AScrBuf: TJclScreenBuffer);
begin
  inherited Create;
  FScreenBuffer := AScrBuf;
end;

function TJclScreenFont.GetTextAttribute: Word;
begin
  Result := ScreenBuffer.Info.wAttributes;
end;

procedure TJclScreenFont.SetTextAttribute(const Value: Word);
begin
  Win32Check(SetConsoleTextAttribute(ScreenBuffer.Handle, Value));
end;

//=== { TJclScreenTextAttribute 0 ============================================

constructor TJclScreenTextAttribute.Create(const Attribute: Word);
begin
  inherited Create;
  FAttribute := Attribute;
end;

constructor TJclScreenTextAttribute.Create(const AColor: TJclScreenFontColor;
  const ABgColor: TJclScreenBackColor; const AHighLight, ABgHighLight: Boolean;
  const AStyle: TJclScreenFontStyles);
begin
  inherited Create;
  Color := AColor;
  BgColor := ABgColor;
  Highlight := AHighLight;
  BgHighlight := ABgHighLight;
  Style := AStyle;
end;

function TJclScreenTextAttribute.GetTextAttribute: Word;
begin
  Result := FAttribute;
end;

procedure TJclScreenTextAttribute.SetTextAttribute(const Value: Word);
begin
  FAttribute := Value;
end;

//=== { TJclScreenCharacter } ================================================

constructor TJclScreenCharacter.Create(const CharInfo: TCharInfo);
begin
  inherited Create;
  FCharInfo := CharInfo;
end;

function TJclScreenCharacter.GetCharacter: Char;
begin
  Result := FCharInfo.AsciiChar;
end;

procedure TJclScreenCharacter.SetCharacter(const Value: Char);
begin
  FCharInfo.AsciiChar := Value;
end;

function TJclScreenCharacter.GetTextAttribute: Word;
begin
  Result := FCharInfo.Attributes;
end;

procedure TJclScreenCharacter.SetTextAttribute(const Value: Word);
begin
  FCharInfo.Attributes := Value;
end;

//=== { TJclScreenCursor } ===================================================

constructor TJclScreenCursor.Create(const AScrBuf: TJclScreenBuffer);
begin
  inherited Create;
  FScreenBuffer := AScrBuf;
end;

function TJclScreenCursor.GetInfo: TConsoleCursorInfo;
begin
  Win32Check(GetConsoleCursorInfo(ScreenBuffer.Handle, Result));
end;

procedure TJclScreenCursor.SetInfo(const Value: TConsoleCursorInfo);
begin
  Win32Check(SetConsoleCursorInfo(ScreenBuffer.Handle, Value));
end;

function TJclScreenCursor.GetPosition: TCoord;
begin
  Result := ScreenBuffer.Info.dwCursorPosition;
end;

procedure TJclScreenCursor.SetPosition(const Value: TCoord);
begin
  Win32Check(SetConsoleCursorPosition(ScreenBuffer.Handle, Value));
end;

function TJclScreenCursor.GetSize: TJclScreenCursorSize;
begin
  Result := Info.dwSize;
end;

procedure TJclScreenCursor.SetSize(const Value: TJclScreenCursorSize);
var
  NewInfo: TConsoleCursorInfo;
begin
  NewInfo := Info;
  NewInfo.dwSize := Value;
  Info := NewInfo;
end;

function TJclScreenCursor.GetVisible: Boolean;
begin
  Result := Info.bVisible;
end;

procedure TJclScreenCursor.SetVisible(const Value: Boolean);
var
  NewInfo: TConsoleCursorInfo;
begin
  NewInfo := Info;
  NewInfo.bVisible := Value;
  Info := NewInfo;
end;

procedure TJclScreenCursor.MoveTo(const DestPos: TCoord);
begin
  Position := DestPos;
end;

procedure TJclScreenCursor.MoveTo(const x, y: Smallint);
var
  DestPos: TCoord;
begin
  DestPos.X := x;
  DestPos.Y := y;
  MoveTo(DestPos);
end;

procedure TJclScreenCursor.MoveBy(const Delta: TCoord);
var
  DestPos: TCoord;
begin
  DestPos := Position;
  Inc(DestPos.X, Delta.X);
  Inc(DestPos.Y, Delta.Y);
  MoveTo(DestPos);
end;

procedure TJclScreenCursor.MoveBy(const cx, cy: Smallint);
var
  DestPos: TCoord;
begin
  DestPos := Position;
  Inc(DestPos.X, cx);
  Inc(DestPos.Y, cy);
  MoveTo(DestPos);
end;

//=== { TJclScreenWindow } ===================================================

constructor TJclScreenWindow.Create(const AScrBuf: TJclScreenBuffer);
begin
  inherited Create;
  FScreenBuffer := AScrBuf;
end;

function TJclScreenWindow.GetMaxConsoleWindowSize: TCoord;
begin
  Result := GetLargestConsoleWindowSize(ScreenBuffer.Handle);
end;

function TJclScreenWindow.GetMaxWindow: TCoord;
begin
  Result := ScreenBuffer.Info.dwMaximumWindowSize;
end;

procedure TJclScreenWindow.InternalSetPosition(const X, Y: SmallInt);
var
  NewRect: TSmallRect;
begin
  if (GetLeft <> X) or (GetTop <> Y) then
  begin
    NewRect.Left := X;
    NewRect.Top := Y;
    NewRect.Right:= NewRect.Left + Width - 1;
    NewRect.Bottom := NewRect.Top + Height - 1;
    DoResize(NewRect);
  end;
end;

procedure TJclScreenWindow.InternalSetSize(const X, Y: SmallInt);
var
  NewRect: TSmallRect;
begin
  if (Width <> X) or (Height <> Y) then
  begin
    NewRect.Left := Left;
    NewRect.Top := Top;
    NewRect.Right := NewRect.Left + X - 1;
    NewRect.Bottom := NewRect.Top + Y - 1;
    DoResize(NewRect);
  end;
end;

function TJclScreenWindow.GetLeft: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Left;
end;

function TJclScreenWindow.GetRight: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Right;
end;

function TJclScreenWindow.GetTop: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Top;
end;

function TJclScreenWindow.GetBottom: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Bottom;
end;

function TJclScreenWindow.GetWidth: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Right - ScreenBuffer.Info.srWindow.Left + 1;
end;

function TJclScreenWindow.GetHeight: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Bottom - ScreenBuffer.Info.srWindow.Top + 1;
end;

procedure TJclScreenWindow.SetLeft(const Value: Smallint);
begin
  InternalSetPosition(Value, Top);
end;

procedure TJclScreenWindow.SetRight(const Value: Smallint);
begin
  InternalSetSize(Value - Left + 1, Height);
end;

procedure TJclScreenWindow.SetTop(const Value: Smallint);
begin
  InternalSetPosition(Left, Value);
end;

procedure TJclScreenWindow.SetBottom(const Value: Smallint);
begin
  InternalSetSize(Width, Value - Top + 1);
end;

procedure TJclScreenWindow.SetWidth(const Value: Smallint);
begin
  InternalSetSize(Value, Height);
end;

procedure TJclScreenWindow.SetHeight(const Value: Smallint);
begin
  InternalSetSize(Width, Value);
end;

function TJclScreenWindow.GetPosition: TCoord;
begin
  Result.X := Left;
  Result.Y := Top;
end;

function TJclScreenWindow.GetSize: TCoord;
begin
  Result.X := Width;
  Result.Y := Height;
end;

procedure TJclScreenWindow.SetPosition(const Value: TCoord);
begin
  InternalSetPosition(Value.X, Value.Y);
end;

procedure TJclScreenWindow.SetSize(const Value: TCoord);
begin
  InternalSetSize(Value.X, Value.Y);
end;

procedure TJclScreenWindow.DoResize(const NewRect: TSmallRect; bAbsolute: Boolean);
begin
  Win32Check(SetConsoleWindowInfo(ScreenBuffer.Handle, bAbsolute, NewRect));
end;

procedure TJclScreenWindow.Scroll(const cx, cy: Smallint);
var
  Delta: TSmallRect;
begin
  Delta.Left := cx;
  Delta.Top := cy;
  Delta.Right := cx;
  Delta.Bottom := cy;
  DoResize(Delta, False);
end;

//=== { TJclInputBuffer } ====================================================

constructor TJclInputBuffer.Create(const AConsole: TJclConsole);
begin
  inherited Create;
  FConsole := AConsole;
  FHandle := CreateFile('CONIN$', GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  Win32Check(INVALID_HANDLE_VALUE <> FHandle);
end;

destructor TJclInputBuffer.Destroy;
begin
  CloseHandle(FHandle);
  inherited Destroy;
end;

procedure TJclInputBuffer.Clear;
begin
  Win32Check(FlushConsoleInputBuffer(Handle));
end;

function TJclInputBuffer.GetMode: TJclConsoleInputModes;
var
  InputMode: DWORD;
  AMode: TJclConsoleInputMode;
begin
  Result := [];
  Win32Check(GetConsoleMode(Handle, InputMode));
  for AMode := Low(TJclConsoleInputMode) to High(TJclConsoleInputMode) do
    if (InputMode and InputModeMapping[AMode]) = InputModeMapping[AMode] then
      Include(Result, AMode);
end;

procedure TJclInputBuffer.SetMode(const Value: TJclConsoleInputModes);
var
  InputMode: DWORD;
  AMode: TJclConsoleInputMode;
begin
  InputMode := 0;
  for AMode := Low(TJclConsoleInputMode) to High(TJclConsoleInputMode) do
    if AMode in Value then
      InputMode := InputMode or InputModeMapping[AMode];
  Win32Check(SetConsoleMode(Handle, InputMode));
end;

procedure TJclInputBuffer.RaiseCtrlEvent(const AEvent: TJclInputCtrlEvent;
  const ProcessGroupId: DWORD);
const
  CtrlEventMapping: array [TJclInputCtrlEvent] of DWORD =
    (CTRL_C_EVENT, CTRL_BREAK_EVENT, CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT, CTRL_SHUTDOWN_EVENT);
begin
  if AEvent in [ceCtrlC, ceCtrlBreak] then
    Win32Check(GenerateConsoleCtrlEvent(CtrlEventMapping[AEvent], ProcessGroupId))
  else
    {$IFDEF CLR}
    raise EJclError.CreateFmt(RsCannotRaiseSignal,
      [GetEnumName(TypeInfo(TJclInputCtrlEvent), Integer(AEvent))]);
    {$ELSE}
    raise EJclError.CreateResFmt(@RsCannotRaiseSignal,
      [GetEnumName(TypeInfo(TJclInputCtrlEvent), Integer(AEvent))]);
    {$ENDIF CLR}
end;

function TJclInputBuffer.GetEventCount: DWORD;
begin
  Win32Check(GetNumberOfConsoleInputEvents(Handle, Result));
end;

function TJclInputBuffer.WaitEvent(const TimeOut: DWORD): Boolean;
begin
  Result := WaitForSingleObject(Handle, TimeOut) = WAIT_OBJECT_0;
end;

function TJclInputBuffer.GetEvents(var Events: TJclInputRecordArray): DWORD;
begin
  Win32Check(ReadConsoleInput(Handle, Events[0], Length(Events), Result));
end;

function TJclInputBuffer.PeekEvents(var Events: TJclInputRecordArray): DWORD;
begin
  if EventCount = 0 then
    Result := 0
  else
    Win32Check(PeekConsoleInput(Handle, Events[0], Length(Events), Result));
end;

function TJclInputBuffer.PutEvents(const Events: TJclInputRecordArray): DWORD;
begin
  Win32Check(WriteConsoleInput(Handle, Events[0], Length(Events), Result));
end;

function TJclInputBuffer.GetEvents(const Count: Integer): TJclInputRecordArray;
begin
  SetLength(Result, Count);
  SetLength(Result, GetEvents(Result));
end;

function TJclInputBuffer.PeekEvents(const Count: Integer): TJclInputRecordArray;
begin
  SetLength(Result, Count);
  SetLength(Result, PeekEvents(Result));
end;

function TJclInputBuffer.GetEvent: TInputRecord;
begin
  Result := GetEvents(1)[0];
end;

function TJclInputBuffer.PeekEvent: TInputRecord;
begin
  Result := PeekEvents(1)[0];
end;

function TJclInputBuffer.PutEvent(const Event: TInputRecord): Boolean;
var
  Evts: TJclInputRecordArray;
begin
  SetLength(Evts, 1);
  Evts[0] := Event;
  Result := PutEvents(Evts) = 1;
end;

// History:

// $Log: JclConsole.pas,v $
// Revision 1.18  2005/05/05 20:08:47  ahuser
// JCL.NET support
//
// Revision 1.17  2005/04/07 00:41:38  rrossmair
// - changed for FPC 1.9.8
//
// Revision 1.16  2005/03/08 08:33:22  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.15  2005/03/04 06:40:26  marquardt
// changed overloaded constructors to constructor with default parameter (BCB friendly)
//
// Revision 1.14  2005/02/25 07:20:15  marquardt
// add section lines
//
// Revision 1.13  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.12  2004/10/17 21:00:14  mthoma
// cleaning
//
// Revision 1.11  2004/08/01 11:40:23  marquardt
// move constructors/destructors
//
// Revision 1.10  2004/07/29 07:58:21  marquardt
// inc files updated
//
// Revision 1.9  2004/05/13 04:23:21  rrossmair
// fixed TJclScreenWindow.InternalSetPosition; FPC-related changes
//
// Revision 1.8  2004/05/06 22:37:09  rrossmair
// contributor list updated
//
// Revision 1.7  2004/05/06 05:09:55  rrossmair
// Changes for FPC v1.9.4 compatibility
//
// Revision 1.6  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.5  2004/04/06 04:55:17
// adapt compiler conditions, add log entry
//

end.