Переключение консольного приложения в полный экран

Code:

{

function GetConsoleDisplayMode(var lpdwMode: DWORD): BOOL; stdcall;

  external 'kernel32.dll';

// lpdwMode: address of variable for current value of display mode

}

function NT_GetConsoleDisplayMode(var lpdwMode: DWORD): Boolean;

type

TGetConsoleDisplayMode = function(var lpdwMode: DWORD): BOOL;

stdcall;

var

hKernel: THandle;

GetConsoleDisplayMode: TGetConsoleDisplayMode;

begin

Result := False;

hKernel := GetModuleHandle('kernel32.dll');

if (hKernel > 0) then

begin @GetConsoleDisplayMode :=

     GetProcAddress(hKernel, 'GetConsoleDisplayMode');

   if Assigned(GetConsoleDisplayMode) then

   begin

     Result := GetConsoleDisplayMode(lpdwMode);

   end;

end;

end;

{

function SetConsoleDisplayMode(hOut: THandle; // standard output handle

dwNewMode: DWORD;         // specifies the display mode

var lpdwOldMode: DWORD    // address of variable for previous value of display mode

): BOOL; stdcall; external 'kernel32.dll';

}

function NT_SetConsoleDisplayMode(hOut: THandle; dwNewMode: DWORD;

var lpdwOldMode: DWORD): Boolean;

type

TSetConsoleDisplayMode = function(hOut: THandle; dwNewMode: DWORD;

var lpdwOldMode: DWORD): BOOL;

stdcall;

var

hKernel: THandle;

SetConsoleDisplayMode: TSetConsoleDisplayMode;

begin

Result := False;

hKernel := GetModuleHandle('kernel32.dll');

if (hKernel > 0) then

begin @SetConsoleDisplayMode :=

     GetProcAddress(hKernel, 'SetConsoleDisplayMode');

   if Assigned(SetConsoleDisplayMode) then

   begin

     Result := SetConsoleDisplayMode(hOut, dwNewMode, lpdwOldMode);

   end;

end;

end;

function GetConsoleWindow: THandle;

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));

   Result := FindWindow(nil, PChar(S));

   S[1] := C;

   SetConsoleTitle(PChar(S));

end;

end;

function SetConsoleFullScreen(bFullScreen: Boolean): Boolean;

const

MAGIC_CONSOLE_TOGGLE = 57359;

var

dwOldMode: DWORD;

dwNewMode: DWORD;

hOut: THandle;

hConsole: THandle;

begin

if Win32Platform = VER_PLATFORM_WIN32_NT then

begin

   dwNewMode := Ord(bFullScreen);

   NT_GetConsoleDisplayMode(dwOldMode);

   hOut := GetStdHandle(STD_OUTPUT_HANDLE);

   Result := NT_SetConsoleDisplayMode(hOut, dwNewMode, dwOldMode);

end

else

begin

   hConsole := GetConsoleWindow;

   Result := hConsole <> 0;

   if Result then

   begin

     if bFullScreen then

     begin

       SendMessage(GetConsoleWindow, WM_COMMAND, MAGIC_CONSOLE_TOGGLE, 0);

     end

     else

     begin

       // Better solution than keybd_event under Win9X ?

       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;

   end;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

s: string;

begin

AllocConsole;

try

   SetConsoleFullScreen(True);

   Write('Hi, you are in full screen mode now. Type something [Return]: ');

   Readln(s);

   SetConsoleFullScreen(False);

   // ShowMessage(Format('You typed: "%s"', [s]));

finally

   FreeConsole;

end;

end;