Переключение консольного приложения в полный экран
- Алло!!! Я у вас купил компьютер и он сдох, а была пожизненая гарантия?!
- Ну все - гарантия кончилась...
{
There is no documented way to make a console application fullscreen.
The following code works for both NT and Win9x.
For win NT I used the undocumented SetConsoleDisplayMode and
GetConsoleDisplayMode functions.
}{
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) thenbegin @GetConsoleDisplayMode :=
GetProcAddress(hKernel, 'GetConsoleDisplayMode');
if Assigned(GetConsoleDisplayMode) thenbegin
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) thenbegin @SetConsoleDisplayMode :=
GetProcAddress(hKernel, 'SetConsoleDisplayMode');
if Assigned(SetConsoleDisplayMode) thenbegin
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 thenbegin
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;
beginif Win32Platform = VER_PLATFORM_WIN32_NT thenbegin
dwNewMode := Ord(bFullScreen);
NT_GetConsoleDisplayMode(dwOldMode);
hOut := GetStdHandle(STD_OUTPUT_HANDLE);
Result := NT_SetConsoleDisplayMode(hOut, dwNewMode, dwOldMode);
endelsebegin
hConsole := GetConsoleWindow;
Result := hConsole <> 0;
if Result thenbeginif bFullScreen thenbegin
SendMessage(GetConsoleWindow, WM_COMMAND, MAGIC_CONSOLE_TOGGLE, 0);
endelsebegin// 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;
Консольное приложение на Delphi, которое пытается переключить окно консоли в полноэкранный режим. Код состоит из нескольких функций и процедур:
GetConsoleDisplayMode и SetConsoleDisplayMode: эти не документированные API-функции используются для получения и установки режима отображения окна консоли на Windows NT.
NT_GetConsoleDisplayMode и NT_SetConsoleDisplayMode: эти обёртки вокруг функций выше, предоставляют более дружественный интерфейс для Delphi.
GetConsoleWindow: эта функция возвращает handle окна консоли с помощью API-функции FindWindow.
SetConsoleFullScreen: это основная функция, которая переключает окно консоли в полноэкранный режим или восстанавливает его к исходному состоянию. Она использует различные подходы в зависимости от платформы Windows (NT vs Win9x).
Button1Click: это процедура, прикреплённая к событию клика кнопки в форме Delphi. Когда она кликнута, создается новый консоль, устанавливается в полноэкранный режим, читается пользовательский ввод и затем восстанавливается окно консоли к исходному состоянию.
Код использует несколько констант и переменных, специфических для функций Windows API, таких как STD_OUTPUT_HANDLE, MAGIC_CONSOLE_TOGGLE, VK_MENU и KEYEVENTF_KEYUP.
Вот пример использования этой функции:
procedureTForm1.Button1Click(Sender:TObject);vars:string;beginAllocConsole;trySetConsoleFullScreen(True);Write('Hi, you are in full screen mode now. Type something [Return]: ');Readln(s);SetConsoleFullScreen(False);finallyFreeConsole;end;end;
Однако стоит отметить, что функции SetConsoleDisplayMode и GetConsoleDisplayMode работают только на Windows NT, а не на Win9x или позднее. Для этих платформ функция использует другой подход для переключения окна консоли в полноэкранный режим.
Кроме того, код не проверяет, имеет ли пользователь административные привилегии перед попыткой установить окно консоли в полноэкранный режим. Это может привести к ошибкам при выполнении приложения без элевации прав.
В статье описывается способ переключения консольного приложения в полный экран на платформах Windows NT и Win9x.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.