Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 16. - Psaní po pracovní ploše; Zjištění velikosti systémového fontu; Změna rozlišení obrazovky; Zachycení změny rozlišení

Jan Šindelář - 7.11.2001

Psaní po pracovní ploše

Pokud toužíte popsat přímo pracovní plochu Windows, ukážeme si jednoduchý postup. Využití této funkce ponechám na vás. Můžete ji využít například v některých specifických případech, kdy potřebujete zobrazovat určitou informaci i tehdy, když uživatel minimalizuje vaši aplikaci. V tom případě můžete vypisovat dané informace například někam do rohu pracovní plochy. A nebo jej využijete k naprosto neseriózním zábavným účelům.

Ovšem pozor, je nutné upozornit na to, že o překreslování vypisovaného textu se musíte postarat sami, protože při dočasném překrytí textu například oknem jiné aplikace text zmizí (tedy přesněji řečeno nebude automaticky opětovně překreslen). Taktéž pokud dojde k "obnovení pracovní plochy" (například výběrem položky Obnovit v kontextovém menu pracovní plochy), text opět zmizí. Proto musíte jeho překreslování hlídat a obnovovat sami.

Ale nyní již k našemu příkladu. Jedná se opět o jednoduchý příklad použitý v události stisku tlačítka. Parametry, které nás budou hlavně zajímat, jsou jednak samotný vypisovaný text, dále jeho souřadnice a barva. Jako font bude použit aktuální systémový font. Text bude vykreslen transparentně a barvu budeme volit opět pomocí trojkombinace RGB.

procedure TForm1.Button1Click(Sender: TObject);
var dc: hdc;
    ocolor: COLORREF;
    oBKM : integer;
    nastext: string;
begin
nastext := `Náš zobrazovaný text`
dc := GetWindowDC(GetDesktopWindow);
try
ocolor := SetTextColor(DC, RGB(0, 255, 0));
oBKM := SetBkMode(DC, TRANSPARENT);
TextOut(DC, 200, 200, nastext, Length(nastext));
SetBkMode(DC, oBKM);
SetTextColor(DC, ocolor);
finally
ReleaseDC(GetDesktopWindow, DC);
end;
end;

Pro úplnost (kdyby to snad nebylo z příkladu jasné) dodávám, že náš příklad vypíše daný text zelenou barvou na souřadnice (200, 200). Souřadnice samozřejmě musíte volit s ohledem na momentální rozlišení obrazovky a při změnách rozlišení (viz dále) je třeba postarat se o překreslení na vhodné místo, protože pokud má být váš text například umístěn v pravém dolním rohu, jeho poloha je pochopitelně závislá na aktuálním rozlišení obrazovky.

Zjištění velikosti systémového fontu

Tento tip se týká "grafiky" jako takové spíše nepřímo, ale přesto je poměrně důležitý. Zkuste si jeden malý test – nastavte v systému velikost fontu na "Velké písmo". Nyní spusťte svoji aplikaci. Možná, že se nestane nic mimořádného, ale pokud je vaše aplikace plná různých nadpisů, jejichž délka je přesně stavěna na velikost malých fontů (které jsou v systému implicitně nastaveny a těsně navazují jeden na druhý či těsně sousedí s ostatními vizuálními prvky formuláře), může se stát, že se při zvětšeném fontu některé nadpisy ořežou.

Lepší je samozřejmě tomuto stavu předcházet a nadpisy volit s rozumem, ale někdy to prostě nelze. Proto zde mám pro vás funkci, která zjistí, které z písem (zda velké či malé) je v systému právě nastaveno, a podle toho můžete případně zareagovat (změnou nastavení formuláře nebo písem a podobně).

function VelikostFontu : integer;
var DC : HDC;
begin
DC := GETDC(0);
Result := 0;
case GetDeviceCaps(DC, LOGPIXELSX) of
96: Result := 1;
102: Result := 2;
end;
ReleaseDC(0, DC);
end;

Pokud funkce vrátí hodnotu 1, jedná se o malý font (96 dpi), číslo 2 znamená velký font (102 dpi). Samozřejmě není problém tuto funkci drobně upravit, aby vracela přímo číslo velikosti, protože jak víte, stále je zde možnost vlastního nastavení, takže teoreticky ani jedna z těchto možností nemusí platit.

Změna rozlišení obrazovky

A dostáváme se ke změně rozlišení obrazovky. Předkládám vám velmi zjednodušené řešení – funkci, jejíž parametry jsou pouze požadované rozlišení a barevná hloubka v bitech. Jako návratová hodnota se nám vrátí 1, pokud vše proběhlo v pořádku a došlo ke změně rozlišení, hodnota 2 se vrátí v případě, že je nutno počítač nejprve restartovat, a hodnota 3 znamená, že došlo k nějaké chybě a rozlišení nelze změnit. Změna nebude pevná, protože se neuloží do registrů a po restartu systému se vrátí k původnímu stavu.

Správnější postupe by patrně byl: nejprve zjistit, která rozlišení jsou dostupná (což ovšem také není problém), a poté jedno z nich vybrat. Vzhledem k tomu, že budete ale pravděpodobně tuto funkci využívat k nastavení konkrétního rozlišení potřebného pro nějaký daný účel, není to myslím třeba. Když dané rozlišení nebude na systému nějakého uživatele dostupné, vrátí nám funkce chybu a vy můžete uživatele informovat. V případě, že bychom vytvářeli cosi jako utilitu na změny rozlišení (podobnou té, která je v systému již obsažena), bylo by zcela jistě na místě použít první způsob, kde budou nabídnuta pouze dostupná nastavení.

Pokud budete chtít pouze otestovat, zda je dané rozlišení v systému dostupné (bez samotné změny), nastavte jako druhý parametr funkce ChangeDisplaySettings hodnotu CDS_TEST (v naší ukázce je parametrem 0, která právě zajistí rovnou změnu rozlišení). Další možností je parametr CDS_UPDATEREGISTRY, který zajistí též uložení nastavení do registru, takže bude platné i po restartu.

function ZmenaRozliseni(Width, Height, Bit: integer): integer;
var
  DvMode : TDeviceMode;
begin
  DvMode.dmSize := SizeOf(TDeviceMode);
  DvMode.dmPelsWidth := Width;
  DvMode.dmPelsHeight := Height;
  DvMode.dmBitsPerPel := Bit;
  DvMode.dmFields := DM_PELSWIDTH + DM_PELSHEIGHT + DM_BITSPERPEL;
  case ChangeDisplaySettings(DvMode, 0) of
      DISP_CHANGE_SUCCESSFUL: Result := 1;
      DISP_CHANGE_RESTART: Result := 2;
  else Result := 3;
  end;
end;

Zachycení změny rozlišení

Poslední dnešní příklad souvisí s předchozím odstavcem. Naučíme se detekovat, zda nedošlo ke změně rozlišení. Pokud ano, může na to naše aplikace eventuelně nějak zareagovat, pokud bude potřeba a pokud to povaha naší aplikace vyžaduje. Jak jinak, opět se bude jednat o zachycení zprávy systému, konkrétně o WM_DISPLAYCHANGE. Zde je tedy kód:

.
.
.
public
    { Public declarations }
    procedure WMDisplayChange(var Msg : TWMDisplayChange); message WM_DISPLAYCHANGE;
end;
.
.
.

procedure TForm1.WMDisplayChange(var Msg: TWMDisplayChange);
begin
inherited;
ShowMessage(`Došlo ke změně rozlišení`);
end;

Na úplný závěr ještě jedna malá poznámka, která se týká tohoto i předchozího příkladu. Pokud jsme hovořili o rozlišení, není to docela přesný termín, jelikož součástí těchto parametrů je i počet barev. Proto by se mělo hovořit spíše o grafickém režimu. Zmiňuji se o tom z toho důvodu, že pokud třeba použijete ve svých aplikacích poslední příklad, dojde k oznámení o změně "rozlišení" i v tom případě, když rozlišení zůstane stejné a změní se pouze barevná hloubka. Tolik pro upřesnění.

A čemu se budeme věnovat příště? I nadále zůstaneme u vylepšování našich aplikací, tentokrát se trošku podíváme na úpravu standardních systémových dialogů a podobně.