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

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

** Sonda LRO pořídila z oběžné dráhy Měsíce zajímavé snímky ** Jsou na nich vidět artefakty všech misí programu Apolla, které přistály na povrchu Měsíce ** Jde například o části lunárních modulů, rovery a dokonce i vlajky

Petr Kubala | 60

Šmírovačka kamerami Googlu: Koukněte se, co nového zachytily na Street View

Šmírovačka kamerami Googlu: Koukněte se, co nového zachytily na Street View

Google stále fotí celý svět do své služby Street View. A novodobou zábavou je hledat v mapách Googlu vtipné záběry. Podívejte se na výběr nejlepších!

redakce | 44

Porno insider: Jak virtuální realita vstupuje do filmů pro dospělé

Porno insider: Jak virtuální realita vstupuje do filmů pro dospělé

** Pornografie údajně představuje třetinu internetové obsahu a je technologický tahounem ** Do erotického obsahu postupně zasahuje i virtuální realita ** Kromě vizuálního vjemu se pracuje také na virtuálním uspokojení toho hmatového

Jan Dudek | 28

Alan Turing: Genius, který matematicky stvořil počítač

Alan Turing: Genius, který matematicky stvořil počítač

Řešením matematického problému se dostal k modelu teoretického stroje, který nese jeho jméno a je základem logiky univerzálních počítačů.

Pavel Tronner | 57


Aktuální číslo časopisu Computer

Velký test 18 bezdrátových sluchátek

Vše o přechodu na DVB-T2

Procesory AMD opět porážejí Intel

7 NVMe M.2 SSD v přímém souboji