//*** CRT_EFD v1.20 - (c)1998-2000, EFD Systems ***
//
//Win32 console mode unit designed to reproduce the text mode
//functionality found in the Crt unit of Turbo Pascal v7.0.  See TP
//for docs.  Several new procedures have been added for convenience.
//
//Known, minor incompatabilities
// - Direct manipulation of 'TextAttr' variable not supported, use SetTextattr().
// - Only text mode 'CO80' is supported.  Mode constant 'Font8x8' sets 50 lines.
// - Window() is not supported.
//
//v1.1 - Modified ReadKey to return proper control and extended key codes
//v1.2 - Modified for D5 compatability
//
//LICENSE AGREEMENT and DISCLAIMER
//
//Copyrighted "freeware" for non-commercial use only.  EFD Systems customers,
//clients and software licensees have full, unrestricted use of this unit.
//
//THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
//ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO
//THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
//PARTICULAR PURPOSE.
//
 
unit Crt_EFD;
 
interface
 
uses Windows, SysUtils;
 
const
  Font8x8 = 256;
  C080 = 3;
var
  LastMode,TextAttr:Word;
  //procedures corresponding to Turbo Pascal Crt unit
  procedure ClrEol;
  procedure ClrScr;
  procedure InsLine;
  procedure DelLine;
  function  WhereX : Integer;
  function  WhereY : Integer;
  procedure GotoXY(X,Y : Integer);
  procedure TextColor(Color:Word);
  procedure TextBackGround(Color:Word);
  procedure HighVideo;
  procedure LowVideo;
  procedure NormVideo;
  function  KeyPressed : Boolean;
  function  ReadKey : Char;
  procedure Delay(Ms: DWord);
  procedure Sound(Hz:DWord);
  procedure NoSound;
  procedure TextMode(Mode:Word);
 
  //additional procedures
  procedure FlushInputBuffer;
  procedure SetTextAttr(Color:Word);
  function  GetTextAttr:Word;
  procedure SetCursor(Size:Integer; Visible:Bool);
  procedure WriteXY(Text:AnsiString; X,Y:Integer; Color:Word);
  procedure SetFullScreen;
  function  GetConsoleWindow:THandle;
 
  {Useful and relevant API routines
     SetConsoleTitle()
  }
implementation
 
const
  FKeys = [#59..#68];
  SKeys = [vk_shift,vk_control,vk_menu,vk_capital];
  Ctrl_Pressed = Left_Ctrl_Pressed OR Right_Ctrl_Pressed;
  Alt_Pressed = Left_Alt_Pressed OR Right_Alt_Pressed;
var
 
  InRec:TInputRecord;
  LastKey:Char=#32;
  LastScan:Char=#32;
  CurMode,NormAttr:Word;
  hStdIn:THandle = 0;
  hStdOut:THandle = 0;
  hStdErr:THandle = 0;
  hConsole:Thandle = 0;
  BI : TConsoleScreenBufferInfo;
  AltKey:AnsiString = '-0123456789=abcdefghijklmnopqrstuvwxyz';
  CvtKey:AnsiString = #130#129#120#121#122#123#124#125#126#127#128+
                      #131#30#48#46#32#18#33#34#35#23#36#37#38+
                      #50#49#24#25#16#19#31#20#22#47#17#45#21#44;
 
 
  procedure ClrEol;
  var
    L, N : DWord;
  begin
    GetConsoleScreenBufferInfo(hStdOut, BI);
    with BI do begin
      L := dwSize.x-dwCursorPosition.x;
      FillConsoleOutputAttribute(hStdOut, TextAttr, L, dwCursorPosition, N);
      FillConsoleOutputCharacter(hStdOut, ' ', L, dwCursorPosition, N);
    end;
  end;
 
 
  procedure ClrScr;
  var
    L,N : DWord;
  begin
    GetConsoleScreenBufferInfo(hStdOut, BI);
    with BI do begin
      dwCursorPosition.x:=0;
      dwCursorPosition.y:=0;
      L:=dwSize.x*dwSize.y;
      FillConsoleOutputAttribute(hStdOut, TextAttr, L, dwCursorPosition, N);
      FillConsoleOutputCharacter(hStdOut, ' ', L, dwCursorPosition, N);
      SetConsoleCursorPosition(hStdout, dwCursorPosition);
    end;
  end;
 
 
  function KeyPressed : Boolean;
  var
    I : DWord;
  begin
    GetNumberofConsoleInputEvents(hStdIn,I);
    Result:=I>0;
  end;
 
 
  function ReadKey : Char;
  var
    I  : DWord;
    OK : Boolean;
  begin
    if LastKey=#0 then
      Result:=LastScan
    else begin
     {$ifdef VER120}
      with InRec.Event.KeyEvent do begin
     {$else}{$ifdef VER130}
      with InRec.Event.KeyEvent do begin
     {$else}
      with InRec.Event.KeyEvent do begin
     {$endif}{$endif}
        repeat
          repeat
            Ok:=ReadConsoleInput(hStdIn,InRec,1,I);
          until OK and (InRec.EventType=KEY_EVENT) and (bKeyDown=False);
          LastScan:=Char(wVirtualScanCode);
        until not (wVirtualKeyCode in SKeys);
        Result:=AsciiChar;
        if dwControlKeyState<>0 then begin
          if Result=#0 then begin
            if (dwControlKeyState and Shift_Pressed)<>0 then begin
              if LastScan in FKeys then LastScan:=Char(Ord(LastScan)+25);
            end else if (dwControlKeyState and Ctrl_Pressed)<>0 then begin
              if LastScan in FKeys then
                LastScan:=Char(Ord(LastScan)+35)
              else case LastScan of
                #55:LastScan:=#114;
                #73:LastScan:=#132;
                #75:LastScan:=#115;
                #77:LastScan:=#116;
                #79:LastScan:=#117;
                #81:LastScan:=#118;
              end;
            end else if (dwControlKeyState and Alt_Pressed)<>0 then begin
              if LastScan in FKeys then LastScan:=Char(Ord(LastScan)+45);
            end;
          end else begin
            if (dwControlKeyState and Ctrl_Pressed)<>0 then begin
              if Result in ['a'..'z'] then Result:=Char(Ord(Result)-96)
            end else if (dwControlKeyState and Alt_Pressed)<>0 then begin
              I:=Pos(Result,AltKey);
              if I>0 then begin
                LastScan:=CvtKey[I];
                Result:=#0;
              end;
            end else if (dwControlKeyState and Shift_Pressed)<>0 then begin
              if Result=#9 then begin
                Result:=#0;
                LastScan:=#15;
              end else CharUpper(PChar(Result));
            end;
          end;
        end;
      end;
    end;
    LastKey:=Result;
  end;
 
 
  function WhereX : Integer;
  begin
    GetConsoleScreenBufferInfo(hStdOut, BI);
    Result := BI.dwCursorPosition.x+1;
  end;
 
 
  function WhereY : Integer;
  begin
    GetConsoleScreenBufferInfo(hStdOut, BI);
    Result := BI.dwCursorPosition.y+1;
  end;
 
 
  procedure GotoXY(X,Y : Integer);
  var
    Coord : TCoord;
  begin
    Coord.x := X-1;
    Coord.y := Y-1;
    SetConsoleCursorPosition(hStdOut, Coord)
  end;
 
 
  procedure TextColor(Color : Word);
  begin
    TextAttr := (TextAttr AND $F0) OR Color;
    SetConsoleTextAttribute(hStdOut,TextAttr);
  end;
 
 
  procedure TextBackGround(Color : Word);
  begin
    if Color<16 then Color := Color SHL 4;
    TextAttr:=(TextAttr AND $F) OR Color;
    SetConsoleTextAttribute(hStdOut,TextAttr);
  end;
 
 
  procedure HighVideo;
  begin
    TextAttr := TextAttr OR $8;
    SetConsoleTextAttribute(hStdOut, TextAttr);
  end;
 
 
  procedure LowVideo;
  begin
    TextAttr := TextAttr AND $F7;
    SetConsoleTextAttribute(hStdOut, TextAttr);
  end;
 
 
  procedure NormVideo;
  begin
    TextAttr := NormAttr;
    SetConsoleTextAttribute(hStdOut, TextAttr);
  end;
 
 
  procedure ScrollV(YDelta : SmallInt);
  var
    CI : TCharInfo;
  begin
    GetConsoleScreenBufferInfo(hStdOut, BI);
    with BI do begin
      CI.AsciiChar := ' ';
      CI.Attributes := TextAttr;
      dwCursorPosition.x:=0;
      if YDelta<0 then Inc(dwCursorPosition.y);
      srWindow.Left:=dwCursorPosition.x;
      srWindow.Top:=dwCursorPosition.y;
      Inc(dwCursorPosition.y,YDelta);
      ScrollConsoleScreenBuffer(hStdOut, srWindow, NIL, dwCursorPosition, CI);
    end;
  end;
 
 
  procedure InsLine;
  begin
    ScrollV(1);
    Dec(BI.dwCursorPosition.y);
    SetConsoleCursorPosition(hStdOut, BI.dwCursorPosition);
  end;
 
 
  procedure DelLine;
  begin
    ScrollV(-1);
    SetConsoleCursorPosition(hStdOut, BI.dwCursorPosition);
  end;
 
 
  procedure Delay(Ms: DWord);
  begin
    Sleep(Ms);
  end;
 
 
  procedure Sound(Hz : DWord);
  begin
    Windows.Beep(Hz, $FFFFFFFF);
  end;
 
 
  procedure NoSound;
  begin
    Windows.Beep(0, 0);
  end;
 
 
  procedure TextMode(Mode : Word);
  var
    Coord : TCoord;
  begin
    Coord.X := 80;
    if (Mode AND Font8x8)<>0 then Coord.Y := 50 else Coord.Y := 25;
    if SetConsoleScreenBufferSize(hStdOut,Coord) then begin
      LastMode := CurMode;
      CurMode := Mode;
    end;
  end;
 
  //New convenience procedures below -----------------------------
 
  procedure FlushInputBuffer;
  //Clear all pending input
  var
    I:DWord;
  begin
    I:=0;
    repeat
      if FlushConsoleInputBuffer(hStdIn) then begin
        Sleep(150);
        GetNumberofConsoleInputEvents(hStdIn,I);
      end else Break;
    until I=0;
  end;
 
 
  procedure WriteXY(Text : AnsiString; X,Y : Integer; Color : Word);
  //Write string in specified color at given location
  var
    Coord : TCoord;
    N : DWord;
  begin
    Coord.x := X-1;
    Coord.y := Y-1;
    SetConsoleCursorPosition(hStdOut, Coord);
    Write(Text);
    FillConsoleOutputAttribute(hStdOut, Color, Length(Text), Coord, N);
  end;
 
 
  procedure SetCursor(Size : Integer; Visible : Bool);
  //Set cursor size and visibility
  var
    CI : TConsoleCursorInfo;
  begin
    GetConsoleCursorInfo(hStdOut,CI);
    if (Size>0) AND (Size<=100) then CI.dwSize := Size;
    CI.bVisible := Visible;
    SetConsoleCursorInfo(hStdOut,CI);
  end;
 
 
  procedure SetTextAttr(Color:Word);
  //Set default text attributes
  begin
    TextAttr := Color;
    SetConsoleTextAttribute(hStdOut, TextAttr);
  end;
 
  function GetTextAttr:Word;
  begin
    Result:=TextAttr;
  end;
 
  function  GetConsoleWindow:THandle;
  //Get handle for console Window
  var
    S:AnsiString;
    C:Char;
  begin
    Result:=0;
    Setlength(S,MAX_PATH+1);
    if GetConsoleTitle(PChar(S),MAX_PATH)<>0 then begin
      C:=S[1];
      S[1]:='$';
      SetConsoleTitle(PChar(S));
      hConsole:=FindWindow(nil,PChar(S));
      S[1]:=C;
      SetConsoleTitle(PChar(S));
      Result:=hConsole;
    end;
  end;
 
  procedure SetFullScreen;
  //switch console into full screen mode
  begin
    keybd_event( VK_MENU, MapVirtualKey( VK_MENU, 0 ), 0, 0 );
    keybd_event( VK_RETURN, MapVirtualKey( VK_RETURN, 0 ), 0, 0 );
    keybd_event( VK_RETURN, MapVirtualKey( VK_RETURN, 0 ),KEYEVENTF_KEYUP, 0 );
    keybd_event( VK_MENU, MapVirtualKey( VK_MENU, 0 ), KEYEVENTF_KEYUP, 0);
  end;
 
 
initialization
 
  hStdIn := GetStdHandle(STD_INPUT_HANDLE);
  hStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
  hStdErr := GetStdHandle(STD_ERROR_HANDLE);
  SetConsoleMode(hStdIn,Enable_Line_Input OR Enable_Echo_Input or Enable_Processed_Input);
  FlushConsoleInputBuffer(hStdIn);
  GetConsoleScreenBufferInfo(hStdOut, BI);
  if BI.dwSize.Y>25 then LastMode := 256 else LastMode := 3;
  CurMode := LastMode;
  NormAttr := BI.wAttributes;
  TextAttr := NormAttr;
 
end.