V druhé části dnešního dílu si pak první příklad rozšíříme a pokusíme se toto konzolové okno automaticky přepnout do celoobrazovkového režimu.
Obě funkce se aktivují stiskem tlačítka a v obou případech se otevře okno konzole. Poté je očekáván vstup uživatele prostřednictvím klasické funkce Readln a takto získaný řetězec je pak vypsán již v grafickém režimu pomocí ShowMessage. Odklepnutím tohoto dialogu se pak okno konzole zavře.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
Button2:
TButton;
procedure Button1Click(Sender:
TObject);
procedure Button2Click(Sender:
TObject);
private
{ Private declarations
}
public
{ Public declarations
}
end;
var
Form1:
TForm1;
implementation
{$R
*.dfm}
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 Result :=
GetConsoleDisplayMode(lpdwMode);
end;
end;
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 Result :=
SetConsoleDisplayMode(hOut, dwNewMode, lpdwOldMode);
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 hConsole <> 0 then
begin
if bFullScreen then
SendMessage(GetConsoleWindow, WM_COMMAND, MAGIC_CONSOLE_TOGGLE, 0)
else
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;
end;
end;
end;
procedure TForm1.Button1Click(Sender:
TObject);
var
s: string;
begin
AllocConsole;
try
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), FOREGROUND_BLUE OR
FOREGROUND_GREEN or BACKGROUND_RED );
Write(`Vlozte text
a stisknete ENTER: `);
Readln(s);
ShowMessage(Format(`Vlozili jste: "%s"`, [s]));
finally
FreeConsole;
end;
end;
procedure TForm1.Button2Click(Sender:
TObject);
var
s: string;
begin
AllocConsole;
try
SetConsoleFullScreen(True);
Write(`Vlozte text a stisknete
ENTER: `);
Readln(s);
SetConsoleFullScreen(False);
// ShowMessage(Format(`Vlozili
jste: "%s"`, [s]));
finally
FreeConsole;
end;
end;
end.
Všimněte si, že jsme v prvním příkladu malinko experimentovali s barvou textu a pozadím. Pochopitelně můžeme funkci SetConsoleTextAttribute vynechat a barvy pak budou "normální". V druhém příkladu je ve zdrojovém kódu úmyslně označen řádek s ShowMessage jako poznámka, protože jinak by se nám nepřepnulo celoobrazovkové zobrazení zpět do grafiky a na první pohled by vás to mohlo při testování příkladu zmást. Pro přepnutí by totiž bylo nutné nejprve odklepnout dialog ShowMessage, který je ovšem dosud "skrytý" pod celoobrazovkovým oknem konzole. Musíme se tak nejprve přepnout ručně pomocí ALT-TAB. Proto je tedy řádek označen jako poznámka a pokud se chcete přesvědčit, že předání parametru opravdu funguje (stejně jako v prvním příkladu), stačí poznámku zrušit. A jak jsem slíbil v úvodu, příklad je plně funkční jak v NT systémech, tak i v generaci 9x.
