Tipy a triky v Delphi, díl 16.

Hlavním tématem dnešního dílu bude změna rozlišení a barevné hloubky Windows. Ukážeme si nejen jak na to, ale také se budeme zabývat tím, jak tuto událost detekovat v našich aplikacích. Dále si předvedeme, jak psát po pracovní ploše, a také se naučíme zjišťovat velikost systémového fontu.
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ě.

Diskuze (3) Další článek: Napster bude brzo překonán

Témata článku: Software, Windows, Programování, Dostupné funkce, DEL, Zjednodušený příklad, Rozlišení, Systémový font, Díl, Velké písmo, Zábavný prvek, Trik, Zábavný účel, Předchozí odstavec, TRI, Pracovní plocha


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

Testy procesorů Ryzen 5000: AMD překonalo Intel ve všech směrech

Testy procesorů Ryzen 5000: AMD překonalo Intel ve všech směrech

** AMD začalo prodávat nové procesory Ryzen 5000 s architekturou Zen 3 ** K dispozici jsou nezávislé testy z celého světa ** AMD překonává Intel ve všech směrech

Karel Javůrek | 69

Karel Javůrek
ProcesoryTestyAMD
CZ.NIC bezplatně naděluje USB/NFC klíče. Jak jej získat?
Lukáš Václavík
CZ.NICeGovernment
Jak v prohlížeči vypnout oznámení zasílaná webovými stránkami

Jak v prohlížeči vypnout oznámení zasílaná webovými stránkami

** Obtěžují vás neustálé dotazy webů, zda chcete zobrazovat oznámení? ** Můžete je zakázat, a to jak kompletně, tak i pro jednotlivé stránky ** Připravili jsme návody pro Chrome, Firefox, Edge a Operu

Karel Kilián | 11

Karel Kilián
Jak na InternetTipyProhlížeče
Teď už Chromium ovládne Windows 10 úplně. Microsoft dokončil WebView2

Teď už Chromium ovládne Windows 10 úplně. Microsoft dokončil WebView2

** Před dvěma lety se Microsoft zasnoubil s Chromem ** Nový Edge není zdaleka jejich jediné dítě ** Ještě důležitější je komponenta WebView2

Jakub Čížek | 53

Jakub Čížek
Windows 10ChromeSoftware
Nejlepší herní notebooky a pracovní stroje: Když máte více než 20 tisíc

Nejlepší herní notebooky a pracovní stroje: Když máte více než 20 tisíc

** Když máte na notebook více než 20 tisíc korun, odpadají kompromisy ** Notebooky na práci dostávají tenká kovová těla a styl ** Herní notebooky zvládnou i nejmodernější hry v plné kvalitě

David Polesný | 43

David Polesný
Notebooky
Starlink podle betatesterů: Rychlejší a levnější než satelitní internet v Česku

Starlink podle betatesterů: Rychlejší a levnější než satelitní internet v Česku

** Reddit se začíná plnit zkušenostmi se Starlinkem ** Při přímé viditelnosti dá i 120 Mb/s ** Klasický satelitní internet už teď dalece překonává

Jakub Čížek | 48

Jakub Čížek
StarlinkPoskytovatelé internetu
Fedora 33 prostě funguje. Linux si zaslouží dobýt laptop, je to ale asi opět marné

Fedora 33 prostě funguje. Linux si zaslouží dobýt laptop, je to ale asi opět marné

** Desktopový Linux funguje a vypadá stále lépe ** Fedora 33 není výjimkou ** Ve stínu Windows a macOS tu vyrostly skvělé alternativy

Jakub Čížek | 156

Jakub Čížek
FedoraOperační systémyLinux
Uživatelé hlásí problémy s jednou z listopadových záplat pro Windows 10
Karel Kilián
Windows UpdateAktualizaceWindows 10

Aktuální číslo časopisu Computer

Jak prodloužit výdrž notebooku

Velké testy: gamepady a inkoustové tiskárny

Důkladný test Sony Playstation 5