Tipy a triky v Delphi, díl 7.

Často se vyskytne potřeba zajistit, aby byl uživatel, který spustí naší aplikaci vícekrát (ať už omylem či úmyslně) přesměrován na původní instanci programu. Ne každá aplikace je stavěna na vícenásobné spuštění, nebo to programátor prostě nechce dopustit z jiného důvodu. Naučíme se teď, jak na to.

Nejprve trocha teorie. Dříve, tedy v časech 16bitových Windows, byla situace celkem snadná. Windows udržovala v proměnné hPrevInst informaci o předchozích instancích programu, takže pokud byla proměnná nenulová, bylo jasné, že již běží. Tato proměnná ve 32bitových Windows sice existuje nadále, jenže je bohužel stále nulová bez ohledu na počet spuštěných programů, takže ji nelze použít. Jedním ze způsobů, jak tento problém vyřešit, je použít tzv. "vzájemné vyloučení" neboli "mutual exclusion", zkráceně mutex. Znalcům vícevláknového programování asi nemusím více vysvětlovat. Pro ostatní snad jen tolik, že se jedná o tzv. "kritickou sekci", což je místo v programu, které je rezervováno pro použití pouze pro jedno vlákno současně, ostatní vlákna musí počkat, dokud první vlákno kritickou sekci neopustí. Přesněji řečeno ostatní vlákna pokračují dál ve svých činnostech do té doby, dokud nechtějí vstoupit do kritické sekce. V tom případě musí počkat, dokud se neuvolní. Náš již zmíněný mutex je druhem kritické sekce, který určitým způsobem překračuje hranice procesu. Zájemce o více informací bych raději odkázal na nějakou literaturu zabývající se vlákny a procesy, zkrátka paralelním (vícevláknovým) programováním.

Jak tedy bude fungovat náš příklad? Nejprve se pokusíme vytvořit mutex určitého jména. Pokud se nám to nepovede, což znamená, že již existuje předchozí instance programu (která daný mutex již vytvořila, a proto jej nelze vytvořit znovu), odešleme všem spuštěným aplikacím zprávu a druhou instanci ukončíme. Onu odeslanou zprávu "rozpozná" pouze první (již běžící) instance naší aplikace a zareaguje tak, že se aktivuje (v případě, že je minimalizovaná se obnoví).

Nejprve projektový soubor upravíme tak, že bude vypadat nějak takto:

program Project1;

uses
  Windows,
  Forms,
  Unit1 in `Unit1.pas` {Form1};

{$R *.RES}

begin
CreateMutex(nil, false, `NaseAplikace`);
if GetLastError = ERROR_ALREADY_EXISTS then
begin
  SendMessage(HWND_BROADCAST, RegisterWindowMessage(`NaseAplikace`), 0, 0);
  Halt(0);
end;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

A dále upravíme tělo a události OnCreate a OnDestroy hlavního formuláře:

var
  OldWindowProc : Pointer;
  NaseZprava : DWord;

function NewWindowProc(WindowHandle : hWnd; TheMessage : LongInt; ParamW : LongInt; ParamL : LongInt) : LongInt stdcall;
begin
if TheMessage = NaseZprava then
begin
  SendMessage(Application.handle, WM_SYSCOMMAND, SC_RESTORE, 0);
  SetForegroundWindow(Application.Handle);
  Result := 0;
  exit;
end;
Result := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
NaseZprava := RegisterWindowMessage(`NaseAplikace`);
OldWindowProc := Pointer(SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;

A to je vše. Pokud program spustíme a je to první instance, nestane se nic. Pokud to bude další instance, ukončí se a první instance se stane aktivní.

V dalším tipu si ukážeme, jak snadno použít v naší aplikaci globální systémové klávesové zkratky, tj. klávesové zkratky fungující v celém systému, i pokud je aktivní jiná aplikace než naše. Nejprve se "hotkey" zaregistruje v systému a poté budeme již jen zachytávat došlé zprávy o stisknutí dané klávesové kombinace a příslušně reagovat. V našem příkladu si ukážeme pro představu například klávesové zkratky CTRL+A a CTRL+B, po jejichž stisknutí ze zobrazí jednoduché upozornění.

Nejprve do sekce private přidáme:

private
  zkratka1, zkratka2: Integer;
  procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;

A dále přidáme procedury na zpracování zpráv a registraci (a zrušení registrace po ukončení aplikace) horkých kláves:

Ukážeme si, jak spustit aplikaci podobně jako hry, tj. ve „fullscreen“ modu. Postup je poměrně snadný – nejprve deaktivujeme systémové klávesy (bohužel pod Windows NT/2000 se nám to jako obvykle nepovede), poté necháme zmizet Hlavní panel a nakonec upravíme okno hlavního formuláře tak, aby se zobrazovalo bez titulkového pruhu a roztažené na celou obrazovku.

Náš kód by mohl vypadat např. nějak takto:

procedure TForm1.FormCreate(Sender: TObject);
var
  HTaskbar : HWND;
  OldVal : LongInt;
begin
try
  HTaskBar:=FindWindow(`Shell_TrayWnd`,nil);
  SystemParametersInfo (97, Word (True), @OldVal, 0) ;
  EnableWindow(HTaskBar,False);
  ShowWindow(HTaskbar,SW_HIDE);
finally
  With Form1 do begin
  BorderStyle :=bsNone;
  FormStyle  :=fsStayOnTop;
  Left        :=0;
  Top        :=0;
  Height      :=Screen.Height;
  Width      :=Screen.Width;
  end;
end
end;

Po ukončení aplikace nezapomeňte zase vše vrátit zpět do normálu (opětovně zobrazit Hlavní panel atd.)

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  HTaskbar : HWND;
  OldVal : LongInt;
begin
HTaskBar:=FindWindow(`Shell_TrayWnd`,nil);
SystemParametersInfo (97, Word (False), @OldVal, 0);
EnableWindow(HTaskBar,True);
ShowWindow(HTaskbar,SW_SHOW);
end;

Na závěr si dnes ukážeme jednu malou drobnost. Pokud jste četli minulý díl seriálu, kdy jsme se mimo jiné učili hýbat a klikat myší, možná si vzpomenete, že jsme poněkud okrajově narazili na problém s umístěním Hlavního panelu (v souvislosti se snahou kliknout na tlačítko Start). Naučíme se teď zjistit, ve které ze čtyř možných poloh se Hlavní panel nachází.

procedure KdeJeTaskbar;
var
  hTaskbar  : HWND;
  T          : TRect;
  ScrW,ScrH  : integer;
begin
ScrW := Screen.Width;
ScrH := Screen.Height;
hTaskBar:=FindWindow(`Shell_TrayWnd`,nil);
GetWindowRect(hTaskBar,T);
if (T.Top > ScrH DIV 2) and (T.Right >= ScrW) then
      ShowMessage(`Hlavní panel je umístěn na dolním okraji obrazovky`)
      else
        if (T.Top < ScrH DIV 2) and (T.Bottom <= ScrW DIV 2) then
        ShowMessage(`Hlavní panel je umístěn na horním okraji obrazovky`)
        else
          if (T.left < ScrW DIV 2) and (T.Top <= 0) then
          ShowMessage(`Hlavní panel je umístěn na levém okraji obrazovky`)
          else
            ShowMessage(`Hlavní panel je umístěn na pravém okraji obrazovky`)
end;

Omlouvám se za poněkud neohrabaný způsob větvení :) , ale náš účel to splní a princip je z toho snadno pochopitelný.