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

Jak funguje největší akumulátor v Česku: podívejte se do elektrárny Dlouhé Stráně

Jak funguje největší akumulátor v Česku: podívejte se do elektrárny Dlouhé Stráně

** Přečerpávací vodní elektrárna Dlouhé stráně je obdivuhodné technické dílo ** Stejná turbína vyrábí elektřinu i tlačí vodu zpět do horního jezera ** Strojovna elektrárny je zabudována v podzemí

David Polesný | 35

Google má nové telefony, počítač a domácí displej. Česko je stále mimo

Google má nové telefony, počítač a domácí displej. Česko je stále mimo

** Google dnes představil novinky ** Dočkali jsme se nového telefonu Pixel 3, tabletopočítače a domácího displeje ** Rozšíření Google Assistenta do dalších zemí se bohužel nekoná

David Polesný | 45

Windows 10 už jsou na 700 milionech počítačů, ale není to jen labutí píseň?

Windows 10 už jsou na 700 milionech počítačů, ale není to jen labutí píseň?

** Windows 10 překonaly hranici 700 milionů instalací ** To je úctyhodné číslo a miliarda se blíží ** Analýzy ale i tak ukazují proměnu, jak používáme počítače a mobily

Jakub Čížek | 49


Aktuální číslo časopisu Computer

Jak vytvořit a spravovat vlastní web

Velký test herních klávesnic a DVB-T2 tunerů

Vše o formátu RAW

Vybíráme nejlepší základní desku