{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2000 by Florian Klaempfl
    member of the Free Pascal development team

    Video unit for Win32/Win64

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit Video;
interface

{$i videoh.inc}
const
  useunicodefunctions : boolean = false;


procedure VideoSetConsoleOutHandle (NewHandle: THandle);

implementation

uses
  windows,dos;

{$i video.inc}

  type
    tunicodecharmappingflag = (umf_noinfo,umf_leadbyte,umf_undefined,
      umf_unused);

    punicodecharmapping = ^tunicodecharmapping;
    tunicodecharmapping = record
       unicode : word;
       flag : tunicodecharmappingflag;
       reserved : byte;
    end;

  const
     mapcp850 : array[0..255] of tunicodecharmapping = (
       (unicode : 0; flag : umf_noinfo; reserved : 0),
       (unicode : 1; flag : umf_noinfo; reserved : 0),
       (unicode : 2; flag : umf_noinfo; reserved : 0),
       (unicode : 3; flag : umf_noinfo; reserved : 0),
       (unicode : 4; flag : umf_noinfo; reserved : 0),
       (unicode : 5; flag : umf_noinfo; reserved : 0),
       (unicode : 6; flag : umf_noinfo; reserved : 0),
       (unicode : 7; flag : umf_noinfo; reserved : 0),
       (unicode : 8; flag : umf_noinfo; reserved : 0),
       (unicode : 9; flag : umf_noinfo; reserved : 0),
       (unicode : 10; flag : umf_noinfo; reserved : 0),
       (unicode : 11; flag : umf_noinfo; reserved : 0),
       (unicode : 12; flag : umf_noinfo; reserved : 0),
       (unicode : 13; flag : umf_noinfo; reserved : 0),
       (unicode : 14; flag : umf_noinfo; reserved : 0),
       (unicode : 15; flag : umf_noinfo; reserved : 0),
       (unicode : 16; flag : umf_noinfo; reserved : 0),
       (unicode : 17; flag : umf_noinfo; reserved : 0),
       (unicode : 18; flag : umf_noinfo; reserved : 0),
       (unicode : 19; flag : umf_noinfo; reserved : 0),
       (unicode : 20; flag : umf_noinfo; reserved : 0),
       (unicode : 21; flag : umf_noinfo; reserved : 0),
       (unicode : 22; flag : umf_noinfo; reserved : 0),
       (unicode : 23; flag : umf_noinfo; reserved : 0),
       (unicode : 24; flag : umf_noinfo; reserved : 0),
       (unicode : 25; flag : umf_noinfo; reserved : 0),
       (unicode : 26; flag : umf_noinfo; reserved : 0),
       (unicode : 27; flag : umf_noinfo; reserved : 0),
       (unicode : 28; flag : umf_noinfo; reserved : 0),
       (unicode : 29; flag : umf_noinfo; reserved : 0),
       (unicode : 30; flag : umf_noinfo; reserved : 0),
       (unicode : 31; flag : umf_noinfo; reserved : 0),
       (unicode : 32; flag : umf_noinfo; reserved : 0),
       (unicode : 33; flag : umf_noinfo; reserved : 0),
       (unicode : 34; flag : umf_noinfo; reserved : 0),
       (unicode : 35; flag : umf_noinfo; reserved : 0),
       (unicode : 36; flag : umf_noinfo; reserved : 0),
       (unicode : 37; flag : umf_noinfo; reserved : 0),
       (unicode : 38; flag : umf_noinfo; reserved : 0),
       (unicode : 39; flag : umf_noinfo; reserved : 0),
       (unicode : 40; flag : umf_noinfo; reserved : 0),
       (unicode : 41; flag : umf_noinfo; reserved : 0),
       (unicode : 42; flag : umf_noinfo; reserved : 0),
       (unicode : 43; flag : umf_noinfo; reserved : 0),
       (unicode : 44; flag : umf_noinfo; reserved : 0),
       (unicode : 45; flag : umf_noinfo; reserved : 0),
       (unicode : 46; flag : umf_noinfo; reserved : 0),
       (unicode : 47; flag : umf_noinfo; reserved : 0),
       (unicode : 48; flag : umf_noinfo; reserved : 0),
       (unicode : 49; flag : umf_noinfo; reserved : 0),
       (unicode : 50; flag : umf_noinfo; reserved : 0),
       (unicode : 51; flag : umf_noinfo; reserved : 0),
       (unicode : 52; flag : umf_noinfo; reserved : 0),
       (unicode : 53; flag : umf_noinfo; reserved : 0),
       (unicode : 54; flag : umf_noinfo; reserved : 0),
       (unicode : 55; flag : umf_noinfo; reserved : 0),
       (unicode : 56; flag : umf_noinfo; reserved : 0),
       (unicode : 57; flag : umf_noinfo; reserved : 0),
       (unicode : 58; flag : umf_noinfo; reserved : 0),
       (unicode : 59; flag : umf_noinfo; reserved : 0),
       (unicode : 60; flag : umf_noinfo; reserved : 0),
       (unicode : 61; flag : umf_noinfo; reserved : 0),
       (unicode : 62; flag : umf_noinfo; reserved : 0),
       (unicode : 63; flag : umf_noinfo; reserved : 0),
       (unicode : 64; flag : umf_noinfo; reserved : 0),
       (unicode : 65; flag : umf_noinfo; reserved : 0),
       (unicode : 66; flag : umf_noinfo; reserved : 0),
       (unicode : 67; flag : umf_noinfo; reserved : 0),
       (unicode : 68; flag : umf_noinfo; reserved : 0),
       (unicode : 69; flag : umf_noinfo; reserved : 0),
       (unicode : 70; flag : umf_noinfo; reserved : 0),
       (unicode : 71; flag : umf_noinfo; reserved : 0),
       (unicode : 72; flag : umf_noinfo; reserved : 0),
       (unicode : 73; flag : umf_noinfo; reserved : 0),
       (unicode : 74; flag : umf_noinfo; reserved : 0),
       (unicode : 75; flag : umf_noinfo; reserved : 0),
       (unicode : 76; flag : umf_noinfo; reserved : 0),
       (unicode : 77; flag : umf_noinfo; reserved : 0),
       (unicode : 78; flag : umf_noinfo; reserved : 0),
       (unicode : 79; flag : umf_noinfo; reserved : 0),
       (unicode : 80; flag : umf_noinfo; reserved : 0),
       (unicode : 81; flag : umf_noinfo; reserved : 0),
       (unicode : 82; flag : umf_noinfo; reserved : 0),
       (unicode : 83; flag : umf_noinfo; reserved : 0),
       (unicode : 84; flag : umf_noinfo; reserved : 0),
       (unicode : 85; flag : umf_noinfo; reserved : 0),
       (unicode : 86; flag : umf_noinfo; reserved : 0),
       (unicode : 87; flag : umf_noinfo; reserved : 0),
       (unicode : 88; flag : umf_noinfo; reserved : 0),
       (unicode : 89; flag : umf_noinfo; reserved : 0),
       (unicode : 90; flag : umf_noinfo; reserved : 0),
       (unicode : 91; flag : umf_noinfo; reserved : 0),
       (unicode : 92; flag : umf_noinfo; reserved : 0),
       (unicode : 93; flag : umf_noinfo; reserved : 0),
       (unicode : 94; flag : umf_noinfo; reserved : 0),
       (unicode : 95; flag : umf_noinfo; reserved : 0),
       (unicode : 96; flag : umf_noinfo; reserved : 0),
       (unicode : 97; flag : umf_noinfo; reserved : 0),
       (unicode : 98; flag : umf_noinfo; reserved : 0),
       (unicode : 99; flag : umf_noinfo; reserved : 0),
       (unicode : 100; flag : umf_noinfo; reserved : 0),
       (unicode : 101; flag : umf_noinfo; reserved : 0),
       (unicode : 102; flag : umf_noinfo; reserved : 0),
       (unicode : 103; flag : umf_noinfo; reserved : 0),
       (unicode : 104; flag : umf_noinfo; reserved : 0),
       (unicode : 105; flag : umf_noinfo; reserved : 0),
       (unicode : 106; flag : umf_noinfo; reserved : 0),
       (unicode : 107; flag : umf_noinfo; reserved : 0),
       (unicode : 108; flag : umf_noinfo; reserved : 0),
       (unicode : 109; flag : umf_noinfo; reserved : 0),
       (unicode : 110; flag : umf_noinfo; reserved : 0),
       (unicode : 111; flag : umf_noinfo; reserved : 0),
       (unicode : 112; flag : umf_noinfo; reserved : 0),
       (unicode : 113; flag : umf_noinfo; reserved : 0),
       (unicode : 114; flag : umf_noinfo; reserved : 0),
       (unicode : 115; flag : umf_noinfo; reserved : 0),
       (unicode : 116; flag : umf_noinfo; reserved : 0),
       (unicode : 117; flag : umf_noinfo; reserved : 0),
       (unicode : 118; flag : umf_noinfo; reserved : 0),
       (unicode : 119; flag : umf_noinfo; reserved : 0),
       (unicode : 120; flag : umf_noinfo; reserved : 0),
       (unicode : 121; flag : umf_noinfo; reserved : 0),
       (unicode : 122; flag : umf_noinfo; reserved : 0),
       (unicode : 123; flag : umf_noinfo; reserved : 0),
       (unicode : 124; flag : umf_noinfo; reserved : 0),
       (unicode : 125; flag : umf_noinfo; reserved : 0),
       (unicode : 126; flag : umf_noinfo; reserved : 0),
       (unicode : 127; flag : umf_noinfo; reserved : 0),
       (unicode : 199; flag : umf_noinfo; reserved : 0),
       (unicode : 252; flag : umf_noinfo; reserved : 0),
       (unicode : 233; flag : umf_noinfo; reserved : 0),
       (unicode : 226; flag : umf_noinfo; reserved : 0),
       (unicode : 228; flag : umf_noinfo; reserved : 0),
       (unicode : 224; flag : umf_noinfo; reserved : 0),
       (unicode : 229; flag : umf_noinfo; reserved : 0),
       (unicode : 231; flag : umf_noinfo; reserved : 0),
       (unicode : 234; flag : umf_noinfo; reserved : 0),
       (unicode : 235; flag : umf_noinfo; reserved : 0),
       (unicode : 232; flag : umf_noinfo; reserved : 0),
       (unicode : 239; flag : umf_noinfo; reserved : 0),
       (unicode : 238; flag : umf_noinfo; reserved : 0),
       (unicode : 236; flag : umf_noinfo; reserved : 0),
       (unicode : 196; flag : umf_noinfo; reserved : 0),
       (unicode : 197; flag : umf_noinfo; reserved : 0),
       (unicode : 201; flag : umf_noinfo; reserved : 0),
       (unicode : 230; flag : umf_noinfo; reserved : 0),
       (unicode : 198; flag : umf_noinfo; reserved : 0),
       (unicode : 244; flag : umf_noinfo; reserved : 0),
       (unicode : 246; flag : umf_noinfo; reserved : 0),
       (unicode : 242; flag : umf_noinfo; reserved : 0),
       (unicode : 251; flag : umf_noinfo; reserved : 0),
       (unicode : 249; flag : umf_noinfo; reserved : 0),
       (unicode : 255; flag : umf_noinfo; reserved : 0),
       (unicode : 214; flag : umf_noinfo; reserved : 0),
       (unicode : 220; flag : umf_noinfo; reserved : 0),
       (unicode : 248; flag : umf_noinfo; reserved : 0),
       (unicode : 163; flag : umf_noinfo; reserved : 0),
       (unicode : 216; flag : umf_noinfo; reserved : 0),
       (unicode : 215; flag : umf_noinfo; reserved : 0),
       (unicode : 402; flag : umf_noinfo; reserved : 0),
       (unicode : 225; flag : umf_noinfo; reserved : 0),
       (unicode : 237; flag : umf_noinfo; reserved : 0),
       (unicode : 243; flag : umf_noinfo; reserved : 0),
       (unicode : 250; flag : umf_noinfo; reserved : 0),
       (unicode : 241; flag : umf_noinfo; reserved : 0),
       (unicode : 209; flag : umf_noinfo; reserved : 0),
       (unicode : 170; flag : umf_noinfo; reserved : 0),
       (unicode : 186; flag : umf_noinfo; reserved : 0),
       (unicode : 191; flag : umf_noinfo; reserved : 0),
       (unicode : 174; flag : umf_noinfo; reserved : 0),
       (unicode : 172; flag : umf_noinfo; reserved : 0),
       (unicode : 189; flag : umf_noinfo; reserved : 0),
       (unicode : 188; flag : umf_noinfo; reserved : 0),
       (unicode : 161; flag : umf_noinfo; reserved : 0),
       (unicode : 171; flag : umf_noinfo; reserved : 0),
       (unicode : 187; flag : umf_noinfo; reserved : 0),
       (unicode : 9617; flag : umf_noinfo; reserved : 0),
       (unicode : 9618; flag : umf_noinfo; reserved : 0),
       (unicode : 9619; flag : umf_noinfo; reserved : 0),
       (unicode : 9474; flag : umf_noinfo; reserved : 0),
       (unicode : 9508; flag : umf_noinfo; reserved : 0),
       (unicode : 193; flag : umf_noinfo; reserved : 0),
       (unicode : 194; flag : umf_noinfo; reserved : 0),
       (unicode : 192; flag : umf_noinfo; reserved : 0),
       (unicode : 169; flag : umf_noinfo; reserved : 0),
       (unicode : 9571; flag : umf_noinfo; reserved : 0),
       (unicode : 9553; flag : umf_noinfo; reserved : 0),
       (unicode : 9559; flag : umf_noinfo; reserved : 0),
       (unicode : 9565; flag : umf_noinfo; reserved : 0),
       (unicode : 162; flag : umf_noinfo; reserved : 0),
       (unicode : 165; flag : umf_noinfo; reserved : 0),
       (unicode : 9488; flag : umf_noinfo; reserved : 0),
       (unicode : 9492; flag : umf_noinfo; reserved : 0),
       (unicode : 9524; flag : umf_noinfo; reserved : 0),
       (unicode : 9516; flag : umf_noinfo; reserved : 0),
       (unicode : 9500; flag : umf_noinfo; reserved : 0),
       (unicode : 9472; flag : umf_noinfo; reserved : 0),
       (unicode : 9532; flag : umf_noinfo; reserved : 0),
       (unicode : 227; flag : umf_noinfo; reserved : 0),
       (unicode : 195; flag : umf_noinfo; reserved : 0),
       (unicode : 9562; flag : umf_noinfo; reserved : 0),
       (unicode : 9556; flag : umf_noinfo; reserved : 0),
       (unicode : 9577; flag : umf_noinfo; reserved : 0),
       (unicode : 9574; flag : umf_noinfo; reserved : 0),
       (unicode : 9568; flag : umf_noinfo; reserved : 0),
       (unicode : 9552; flag : umf_noinfo; reserved : 0),
       (unicode : 9580; flag : umf_noinfo; reserved : 0),
       (unicode : 164; flag : umf_noinfo; reserved : 0),
       (unicode : 240; flag : umf_noinfo; reserved : 0),
       (unicode : 208; flag : umf_noinfo; reserved : 0),
       (unicode : 202; flag : umf_noinfo; reserved : 0),
       (unicode : 203; flag : umf_noinfo; reserved : 0),
       (unicode : 200; flag : umf_noinfo; reserved : 0),
       (unicode : 305; flag : umf_noinfo; reserved : 0),
       (unicode : 205; flag : umf_noinfo; reserved : 0),
       (unicode : 206; flag : umf_noinfo; reserved : 0),
       (unicode : 207; flag : umf_noinfo; reserved : 0),
       (unicode : 9496; flag : umf_noinfo; reserved : 0),
       (unicode : 9484; flag : umf_noinfo; reserved : 0),
       (unicode : 9608; flag : umf_noinfo; reserved : 0),
       (unicode : 9604; flag : umf_noinfo; reserved : 0),
       (unicode : 166; flag : umf_noinfo; reserved : 0),
       (unicode : 204; flag : umf_noinfo; reserved : 0),
       (unicode : 9600; flag : umf_noinfo; reserved : 0),
       (unicode : 211; flag : umf_noinfo; reserved : 0),
       (unicode : 223; flag : umf_noinfo; reserved : 0),
       (unicode : 212; flag : umf_noinfo; reserved : 0),
       (unicode : 210; flag : umf_noinfo; reserved : 0),
       (unicode : 245; flag : umf_noinfo; reserved : 0),
       (unicode : 213; flag : umf_noinfo; reserved : 0),
       (unicode : 181; flag : umf_noinfo; reserved : 0),
       (unicode : 254; flag : umf_noinfo; reserved : 0),
       (unicode : 222; flag : umf_noinfo; reserved : 0),
       (unicode : 218; flag : umf_noinfo; reserved : 0),
       (unicode : 219; flag : umf_noinfo; reserved : 0),
       (unicode : 217; flag : umf_noinfo; reserved : 0),
       (unicode : 253; flag : umf_noinfo; reserved : 0),
       (unicode : 221; flag : umf_noinfo; reserved : 0),
       (unicode : 175; flag : umf_noinfo; reserved : 0),
       (unicode : 180; flag : umf_noinfo; reserved : 0),
       (unicode : 173; flag : umf_noinfo; reserved : 0),
       (unicode : 177; flag : umf_noinfo; reserved : 0),
       (unicode : 8215; flag : umf_noinfo; reserved : 0),
       (unicode : 190; flag : umf_noinfo; reserved : 0),
       (unicode : 182; flag : umf_noinfo; reserved : 0),
       (unicode : 167; flag : umf_noinfo; reserved : 0),
       (unicode : 247; flag : umf_noinfo; reserved : 0),
       (unicode : 184; flag : umf_noinfo; reserved : 0),
       (unicode : 176; flag : umf_noinfo; reserved : 0),
       (unicode : 168; flag : umf_noinfo; reserved : 0),
       (unicode : 183; flag : umf_noinfo; reserved : 0),
       (unicode : 185; flag : umf_noinfo; reserved : 0),
       (unicode : 179; flag : umf_noinfo; reserved : 0),
       (unicode : 178; flag : umf_noinfo; reserved : 0),
       (unicode : 9632; flag : umf_noinfo; reserved : 0),
       (unicode : 160; flag : umf_noinfo; reserved : 0)
     );


const
    LastCursorType: word = crUnderline;
    OrigScreen: PVideoBuf = nil;
    OrigScreenSize: cardinal = 0;
    ConsoleOutDeviceName: string [8] = 'CONOUT$'#0;

var ConsoleInfo : TConsoleScreenBufferInfo;
    ConsoleCursorInfo : TConsoleCursorInfo;

    OrigCP: cardinal;
    OrigConsoleCursorInfo : TConsoleCursorInfo;
    OrigConsoleInfo : TConsoleScreenBufferInfo;
    NoConsoleOnStart: boolean;
    NewConsoleHandleAllocated:  boolean;
    ConsoleOutHandle: THandle;

procedure SysInitVideo;
var
  SecAttr: TSecurityAttributes;
begin
  ScreenColor:=true;
  if NoConsoleOnStart then
   begin
    if not (AllocConsole) then
     begin
      WriteLn ('Error: No console available and console creation failed!');
      RunError (103);
     end;
{Reopen StdOut/StdErr/StdIn}
    OrigCP := GetACP;
    with SecAttr do
     begin 
      nLength := SizeOf (TSecurityAttributes);
      SecAttr.bInheritHandle := true;
      SecAttr.lpSecurityDescriptor := nil;
     end;
    ConsoleOutHandle := CreateFile (@ConsoleOutDeviceName [1], Generic_Read or Generic_Write, File_Share_Write, @SecAttr, Open_Existing, File_Attribute_Normal, 0);
    if ConsoleOutHandle = Invalid_Handle_Value then
     begin
      WriteLn ('Error: Console output not possible!');
      RunError (103);
     end
    else
     NewConsoleHandleAllocated := true;
    GetConsoleScreenBufferInfo (ConsoleOutHandle, ConsoleInfo);
    GetConsoleCursorInfo (ConsoleOutHandle, ConsoleCursorInfo);
   end
  else
   begin
    GetConsoleScreenBufferInfo(ConsoleOutHandle, OrigConsoleInfo);
    GetConsoleCursorInfo(ConsoleOutHandle, OrigConsoleCursorInfo);
    OrigCP := GetConsoleCP;
    ConsoleInfo:=OrigConsoleInfo;
    ConsoleCursorInfo:=OrigConsoleCursorInfo;
   end;
  {
    About the ConsoleCursorInfo record: There are 3 possible
    structures in it that can be regarded as the 'screen':
    - dwsize   : contains the cols & row in current screen buffer.
    - srwindow : Coordinates (relative to buffer) of upper left
                 & lower right corners of visible console.
    - dmMaximumWindowSize : Maximal size of Screen buffer.
    The first implementation of video used srWindow. After some
    bug-reports, this was switched to dwMaximumWindowSize.
  }
  with ConsoleInfo.dwMaximumWindowSize do
    begin
    ScreenWidth:=X;
    ScreenHeight:=Y;
    end;
  { TDrawBuffer only has FVMaxWidth elements
    larger values lead to crashes }
  if ScreenWidth> FVMaxWidth then
    ScreenWidth:=FVMaxWidth;
  CursorX:=ConsoleInfo.dwCursorPosition.x;
  CursorY:=ConsoleInfo.dwCursorPosition.y;
  if not ConsoleCursorInfo.bvisible then
    CursorLines:=0
  else
    CursorLines:=ConsoleCursorInfo.dwSize;
end;



procedure VideoSetConsoleOutHandle (NewHandle: THandle);
begin
  if NewHandle <> ConsoleOutHandle then
   begin
    if NewConsoleHandleAllocated then
     begin
      CloseHandle (ConsoleOutHandle);
      NewConsoleHandleAllocated := false;
     end;
    ConsoleOutHandle := NewHandle;
   end;
end;



procedure SysDoneVideo;
begin
  if NoConsoleOnStart then
   begin
    CloseHandle (ConsoleOutHandle);
    NewConsoleHandleAllocated := false;
    ConsoleOutHandle := Invalid_Handle_Value;
    FreeConsole;
   end
  else
   begin
    SetConsoleScreenBufferSize (ConsoleOutHandle, OrigConsoleInfo.dwSize);
    SetConsoleWindowInfo (ConsoleOutHandle, true, OrigConsoleInfo.srWindow);
    SetConsoleCursorInfo(ConsoleOutHandle, OrigConsoleCursorInfo);
    SetConsoleCP(OrigCP);
   end;
end;


function SysGetCapabilities: Word;
begin
  SysGetCapabilities:=cpColor or cpChangeCursor;
end;


procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
var
  pos : COORD;
begin
   pos.x:=NewCursorX;
   pos.y:=NewCursorY;
   SetConsoleCursorPosition(ConsoleOutHandle,pos);
   CursorX:=pos.x;
   CursorY:=pos.y;
end;


function SysGetCursorType: Word;
begin
   GetConsoleCursorInfo(ConsoleOutHandle,ConsoleCursorInfo);
   if not ConsoleCursorInfo.bvisible then
     SysGetCursorType:=crHidden
   else
     case ConsoleCursorInfo.dwSize of
        1..30:
          SysGetCursorType:=crUnderline;
        31..70:
          SysGetCursorType:=crHalfBlock;
        71..100:
          SysGetCursorType:=crBlock;
     end;
end;


procedure SysSetCursorType(NewType: Word);
begin
   GetConsoleCursorInfo(ConsoleOutHandle,ConsoleCursorInfo);
   if newType=crHidden then
     ConsoleCursorInfo.bvisible:=false
   else
     begin
        ConsoleCursorInfo.bvisible:=true;
        case NewType of
           crUnderline:
             ConsoleCursorInfo.dwSize:=10;

           crHalfBlock:
             ConsoleCursorInfo.dwSize:=50;

           crBlock:
             ConsoleCursorInfo.dwSize:=99;
        end
     end;
   SetConsoleCursorInfo(ConsoleOutHandle,ConsoleCursorInfo);
end;

function SysVideoModeSelector (const VideoMode: TVideoMode): boolean;

var MI: Console_Screen_Buffer_Info;
    C: Coord;
    SR: Small_Rect;

begin
  if not (GetConsoleScreenBufferInfo (ConsoleOutHandle, MI)) then
    SysVideoModeSelector := false
  else
    begin
      with MI do
        begin
          C.X := VideoMode.Col;
          C.Y := VideoMode.Row;
        end;
      with SR do
        begin
          Top := 0;
          Left := 0;
          { First, we need to make sure we reach the minimum window size
            to always fit in the new buffer after changing buffer size. }
          Right := MI.srWindow.Right - MI.srWindow.Left;
          if VideoMode.Col <= Right then
            Right := Pred (VideoMode.Col);
          Bottom := MI.srWindow.Bottom - MI.srWindow.Top;
          if VideoMode.Row <= Bottom then
            Bottom := Pred (VideoMode.Row);
        end;
      if SetConsoleWindowInfo (ConsoleOutHandle, true, SR) then
        if SetConsoleScreenBufferSize (ConsoleOutHandle, C) then
          begin
            with SR do
              begin
                { Now, we can resize the window to the final size. }
                Right := Pred (VideoMode.Col);
                Bottom := Pred (VideoMode.Row);
              end;
            if SetConsoleWindowInfo (ConsoleOutHandle, true, SR) then
              begin
                SysVideoModeSelector := true;
                SetCursorType (LastCursorType);
                ClearScreen;
              end
            else
              begin
                SysVideoModeSelector := false;
                SetConsoleScreenBufferSize (ConsoleOutHandle, MI.dwSize);
                SetConsoleWindowInfo (ConsoleOutHandle, true, MI.srWindow);
                SetCursorType (LastCursorType);
              end
          end
        else
          begin
            SysVideoModeSelector := false;
            SetConsoleWindowInfo (ConsoleOutHandle, true, MI.srWindow);
            SetCursorType (LastCursorType);
          end
      else
        SysVideoModeSelector := false;
    end;
end;

Const
  SysVideoModeCount = 6;
  SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
   (Col: 40; Row: 25; Color: True),
   (Col: 80; Row: 25; Color: True),
   (Col: 80; Row: 30; Color: True),
   (Col: 80; Row: 43; Color: True),
   (Col: 80; Row: 50; Color: True),
   (Col: 80; Row: 25; Color: True) // Reserved for TargetEntry
  );


Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;

Var
  I : Integer;

begin
  I:=SysVideoModeCount-1;
  SysSetVideoMode:=False;
  While (I>=0) and Not SysSetVideoMode do
    If (Mode.col=SysVMD[i].col) and
       (Mode.Row=SysVMD[i].Row) and
       (Mode.Color=SysVMD[i].Color) then
      SysSetVideoMode:=True
    else
      Dec(I);
  If SysSetVideoMode then
    begin
    if SysVideoModeSelector(Mode) then
      begin
      ScreenWidth:=SysVMD[I].Col;
      ScreenHeight:=SysVMD[I].Row;
      ScreenColor:=SysVMD[I].Color;
      end else SysSetVideoMode := false;
    end;
end;

Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;

begin
  SysGetVideoModeData:=(Index<=high(SysVMD));
  If SysGetVideoModeData then
    Data:=SysVMD[Index];
end;

Function SysGetVideoModeCount : Word;

begin
  SysGetVideoModeCount:=SysVideoModeCount;
end;

procedure SysClearScreen;
begin
  UpdateScreen(true);
end;

procedure SysUpdateScreen(Force: Boolean);

type WordRec = record
                  One, Two: Byte;
               end; { wordrec }

var
   BufSize,
   BufCoord    : COORD;
   WriteRegion : SMALL_RECT;
   LineBuf     : Array[0..(1024*32) - 1] of TCharInfo;
   BufCounter  : Longint;
   LineCounter,
   ColCounter  : Longint;
   smallforce  : boolean;
   x1,y1,x2,y2 : longint;
   p1,p2,p3    : PCardinal;
   j           : integer;
begin
  if force then
   smallforce:=true
  else
   begin
    {$ifdef cpui386}
     asm
        pushl   %esi
        pushl   %edi
        movl    VideoBuf,%esi
        movl    OldVideoBuf,%edi
        movl    VideoBufSize,%ecx
        shrl    $2,%ecx
        repe
        cmpsl
        setne   smallforce
        popl    %edi
        popl    %esi
     end;
   {$else}
    {$ifdef cpux86_64}
     asm
        pushq   %rsi
        pushq   %rdi
        xorq    %rcx,%rcx  
        movq    VideoBuf(%rip),%rsi
        movq    OldVideoBuf(%rip),%rdi
        movl    VideoBufSize(%rip),%ecx
        shrq    $2,%rcx
        repe
        cmpsl
        setne   smallforce
        popq    %rdi
        popq    %rsi
     end;
    {$else}
      {$INFO No optimized version for this CPU, reverting to a pascal version}
       j:=Videobufsize shr 2;
       smallforce:=false;
       p1:=pcardinal(VideoBuf);
       p2:=pcardinal(OldVideoBuf);
       p3:=@pcardinal(videobuf)[j];
       while (p1<p3) and (p1^=p2^) do
         begin
           inc(p1); inc(p2);
         end; 
       smallforce:=p1<>p3;  
    {$ENDIF}
   {$endif}
   end;
  if SmallForce then
   begin
      BufSize.X := ScreenWidth;
      BufSize.Y := ScreenHeight;

      BufCoord.X := 0;
      BufCoord.Y := 0;
      with WriteRegion do
        begin
           Top :=0;
           Left :=0;
           Bottom := ScreenHeight-1;
           Right := ScreenWidth-1;
        end;
      BufCounter := 0;
      x1:=ScreenWidth+1;
      x2:=-1;
      y1:=ScreenHeight+1;
      y2:=-1;
      for LineCounter := 1 to ScreenHeight do
        begin
           for ColCounter := 1 to ScreenWidth do
             begin
               if (WordRec(VideoBuf^[BufCounter]).One<>WordRec(OldVideoBuf^[BufCounter]).One) or
                 (WordRec(VideoBuf^[BufCounter]).Two<>WordRec(OldVideoBuf^[BufCounter]).Two) then
                 begin
                    if ColCounter<x1 then
                      x1:=ColCounter;
                    if ColCounter>x2 then
                      x2:=ColCounter;
                    if LineCounter<y1 then
                      y1:=LineCounter;
                    if LineCounter>y2 then
                      y2:=LineCounter;
                 end;
               if useunicodefunctions then
                 LineBuf[BufCounter].UniCodeChar := Widechar(mapcp850[WordRec(VideoBuf^[BufCounter]).One].unicode)
               else
                 LineBuf[BufCounter].UniCodeChar := Widechar(WordRec(VideoBuf^[BufCounter]).One);
               { If (WordRec(VideoBuf^[BufCounter]).Two and $80)<>0 then
                 LineBuf^[BufCounter].Attributes := $100+WordRec(VideoBuf^[BufCounter]).Two
               else }
               LineBuf[BufCounter].Attributes := WordRec(VideoBuf^[BufCounter]).Two;

               Inc(BufCounter);
             end; { for }
        end; { for }
      BufSize.X := ScreenWidth;
      BufSize.Y := ScreenHeight;

      with WriteRegion do
        begin
           if force then
             begin
               Top := 0;
               Left :=0;
               Bottom := ScreenHeight-1;
               Right := ScreenWidth-1;
               BufCoord.X := 0;
               BufCoord.Y := 0;
             end
           else
             begin
               Top := y1-1;
               Left :=x1-1;
               Bottom := y2-1;
               Right := x2-1;
               BufCoord.X := x1-1;
               BufCoord.Y := y1-1;
             end;
        end;
      {
      writeln('X1: ',x1);
      writeln('Y1: ',y1);
      writeln('X2: ',x2);
      writeln('Y2: ',y2);
      }
      if useunicodefunctions then
        WriteConsoleOutputW(ConsoleOutHandle, @LineBuf, BufSize, BufCoord, WriteRegion)
      else
        WriteConsoleOutput(ConsoleOutHandle, @LineBuf, BufSize, BufCoord, WriteRegion);

      move(VideoBuf^,OldVideoBuf^,VideoBufSize);
   end;
end;

Const
  SysVideoDriver : TVideoDriver = (
    InitDriver : @SysInitVideo;
    DoneDriver : @SysDoneVideo;
    UpdateScreen : @SysUpdateScreen;
    ClearScreen : @SysClearScreen;
    SetVideoMode : @SysSetVideoMode;
    GetVideoModeCount : @SysGetVideoModeCount;
    GetVideoModeData : @SysGetVideoModeData;
    SetCursorPos : @SysSetCursorPos;
    GetCursorType : @SysGetCursorType;
    SetCursorType : @SysSetCursorType;
    GetCapabilities : @SysGetCapabilities

  );

procedure TargetEntry;
var
  C: Coord;
  SR: Small_Rect;
  VioMode: TConsoleScreenBufferInfo;
  SecAttr: TSecurityAttributes;
begin
  NewConsoleHandleAllocated := false;
  FillChar (VioMode, 0, SizeOf (VioMode));
  ConsoleOutHandle := GetStdHandle (Std_Output_Handle);
{MSDN: If an application does not have associated standard handles, such as a service running on an
 interactive desktop, and has not redirected them, the return value is NULL.}
  if (ConsoleOutHandle = 0) or (ConsoleOutHandle = Invalid_Handle_Value) then
   NoConsoleOnStart := true
  else
   if not (GetConsoleScreenBufferInfo (ConsoleOutHandle, VioMode)) then
    begin
{ StdOut may be redirected, let's try to access the console using a new handle }
     with SecAttr do
      begin 
       nLength := SizeOf (TSecurityAttributes);
       SecAttr.bInheritHandle := true;
       SecAttr.lpSecurityDescriptor := nil;
      end;
     ConsoleOutHandle := CreateFile (@ConsoleOutDeviceName [1], Generic_Read or Generic_Write, File_Share_Write, @SecAttr, Open_Existing, File_Attribute_Normal, 0);
     if ConsoleOutHandle = Invalid_Handle_Value then
      NoConsoleOnStart := true
     else
      NewConsoleHandleAllocated := true;
     if not (GetConsoleScreenBufferInfo (ConsoleOutHandle, VioMode)) then
      begin
       NoConsoleOnStart := true;
       CloseHandle (ConsoleOutHandle);
       ConsoleOutHandle := Invalid_Handle_Value;
       NewConsoleHandleAllocated := false;
      end;
    end;
  if not (NoConsoleOnStart) then
   begin
    with VioMode do
     begin
      OrigScreenSize := max(dwMaximumWindowSize.X,dwSize.X) * max(dwMaximumWindowSize.Y,dwSize.Y) * SizeOf (Char_Info);
      if OrigScreenSize > 0 then
       begin
      { Register the curent video mode in reserved slot in System Modes}
        SysVMD[SysVideoModeCount-1].Col:=dwMaximumWindowSize.X;
        SysVMD[SysVideoModeCount-1].Row:=dwMaximumWindowSize.Y;
        SysVMD[SysVideoModeCount-1].Color:=true;
        GetMem (OrigScreen, OrigScreenSize);
       end;
     end;
    if OrigScreenSize > 0 then
     begin
      with C do
       begin
        X := 0;
        Y := 0;
       end;
      with SR do
       begin
        Top := 0;
        Left := 0;
        Right := Pred (VioMode.dwSize.X);
        Bottom := Pred (VioMode.dwSize.Y);
       end;
      if not (ReadConsoleOutput (ConsoleOutHandle, OrigScreen, VioMode.dwSize, C, SR)) then
       begin
        FreeMem (OrigScreen, OrigScreenSize);
        OrigScreen := nil;
        OrigScreenSize := 0;
       end;
     end;
   end;
end;


initialization
  SetVideoDriver(SysVideoDriver);
  TargetEntry;

finalization
  if (OrigScreenSize <> 0) and (OrigScreen <> nil) then
    begin
      FreeMem (OrigScreen, OrigScreenSize);
      OrigScreen := nil;
      OrigScreenSize := 0;
    end;
  if NewConsoleHandleAllocated then
   CloseHandle (ConsoleOutHandle);
end.
