Tipy a triky v Delphi, díl 96.

Další drobnost, která nás dnes čeká, se opět týká Windows XP a opět vizuálních témat. Nechte se překvapit.
Už jsme si ukazovali testování, zda jsou styly zapnuté či dokonce jak odchytit přímo změnu stylu "za běhu". Teď je na řadě drobnost, která sice nemá přímo nějaký viditelný efekt či použití pro uživatele, ale přesto se nám někdy může hodit. Ukážeme si, jak zjistit jméno aktuálního stylu (tj. jméno souboru včetně cesty, kde je uložen), dále barevné schéma, které styl používá, a konečně velikost písma (např. normal, extralarge atd..).

Opět budeme využívat externí systémovou dll knihovnu a celý zdrojový kód bude vypadat následovně:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComObj;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  GetCurrentThemeName: function (pszThemeFileName: LPWSTR; cchMaxNameChars: Integer; pszColorBuff: LPWSTR; cchMaxColorChars: Integer; pszSizeBuff: LPWSTR; cchMaxSizeChars: Integer): HRESULT; stdcall;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName, ColorScheme, SizeName: WideString;
  hThemeLib: THandle;
begin
  try
    hThemeLib := LoadLibrary(`uxtheme.dll`);
    if hThemeLib > 0 then GetCurrentThemeName := GetProcAddress(hThemeLib, `GetCurrentThemeName`);
    if Assigned(GetCurrentThemeName) then
    begin
      SetLength(FileName, 255);
      SetLength(ColorScheme, 255);
      SetLength(SizeName, 255);
      OleCheck(GetCurrentThemeName(PWideChar(FileName), 255, PWideChar(ColorScheme), 255, PWideChar(SizeName), 255));
      ShowMessage(PWideChar(FileName) + `  ` + PWideChar(ColorScheme) + `  ` + PWideChar(SizeName));
    end;
  finally
    FreeLibrary(hThemeLib);
  end;
end;

end.

Po stisknutí tlačítka budou všechny hledané informace vypsány pomocí ShowMessage. Zřejmě je zbytečné připomínat, že tato funkce má samozřejmě smysl pouze pod Windows XP a v ostatních verzích Windows se nestane nic.

Váš názor Další článek: VIA končí se základními deskami pro Pentium 4

Témata článku: Software, Windows, Programování, Viditelný efekt, Trik, Díl, Filename


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

Velká jarní aktualizace Windows 10: Co přináší April 2018 Update

Velká jarní aktualizace Windows 10: Co přináší April 2018 Update

** Po necelém půl roce je tu další aktualizace Windows ** Přináší časovou osu nebo sdílení souborů jako na mobilu ** A také Application Guard, který umí virtualizovat Edge

Jakub Čížek | 143

Rekordy počasí: V Česku to ještě jde, skutečné extrémy zažívají jinde

Rekordy počasí: V Česku to ještě jde, skutečné extrémy zažívají jinde

** Teplotní extrémy dokážou překvapit. Seznamte se s rekordy v Česku i ve světě ** Rekordní hodnoty jsou mnohdy až k neuvěření ** Zjistěte, kdy ke bylo největší horko, zima, déšť či vítr

Karel Kilián | 7

WALL-E vyfotil Zemi ze vzdálenosti 1 milionů km

WALL-E vyfotil Zemi ze vzdálenosti 1 milionů km

** Malá sonda s přezdívkou WALL-E pořídila fotografii Země a Měsíce ze vzdálenosti 1 milionů km ** CubeSat letí se sondou InSight k Marsu ** InSight přistane na Marsu 26. listopadu

Petr Kubala | 4

Google ADT-2: Miniaturní krabička s Android TV 8.0, kterou si nikdy nekoupíte

Google ADT-2: Miniaturní krabička s Android TV 8.0, kterou si nikdy nekoupíte

** Dlouho se nevědělo, co to přesně má být ** Pak se s krabičkou Google pochlubil na I/O ** Do „Chromecastu“ vtěsnal celý Android TV

Jakub Čížek | 22


Aktuální číslo časopisu Computer

Kdy necháme řídit chytrá auta?

6 Wi-Fi Mesh systémů ve velkém testu

Srovnali jsme 7 sportovních kamer

Znáte pravidla pro létání s drony?