Tipy a triky v Delphi, díl 107. - konzolové aplikace

Abychom sérii tipů pro NT také prostřídali běžnými tipy, povíme si dneska opět něco o konzolových aplikacích.
Nebude řeč přímo o konzolových aplikacích, ale o otevření okna konzole. První tip bude velmi krátký. Ukážeme si v něm, jak z naší běžné Windows aplikace otevřít okno textové konzole. V něm pak můžeme použít všechny běžné příkazy, uživatel může například zadat nějaký text a ten pak můžeme zpracovat zpět v grafickém prostředí naší aplikace.

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.

Diskuze (1) Další článek: Microsoft reaguje na díru v záplatě

Témata článku: Software, Windows, Programování, Díl, Trik

Určitě si přečtěte


Aktuální číslo časopisu Computer

Test 6 odolných telefonů a 22 powerbank

Srovnání technologií QLED a OLED

Měřte své sportovní výkony

Sady pro chytrou domácnost