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.

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

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

Velká podzimní aktualizace Windows 10 je tady: Co přináší Fall Creators Update

Velká podzimní aktualizace Windows 10 je tady: Co přináší Fall Creators Update

** Po půl roce je tu další aktualizace Windows ** A opět přináší hlavně hromadu drobných kosmetických vylepšení ** Podívali jsme se na ty nejzajímavější

17.  10.  2017 | Jakub Čížek | 186

Jak funguje největší akumulátor v Česku: podívejte se do elektrárny Dlouhé Stráně

Jak funguje největší akumulátor v Česku: podívejte se do elektrárny Dlouhé Stráně

** Přečerpávací vodní elektrárna Dlouhé stráně je obdivuhodné technické dílo ** Stejná turbína vyrábí elektřinu i tlačí vodu zpět do horního jezera ** Strojovna elektrárny je zabudována v podzemí

19.  10.  2017 | David Polesný | 23

Přichází doba hypersonických zbraní. Hrozí zvýšené riziko jaderného konfliktu

Přichází doba hypersonických zbraní. Hrozí zvýšené riziko jaderného konfliktu

** Světové mocnosti vyvíjí nové, nesmírně rychlé zbraně ** Jsou schopné pokořit rychlost Mach 5 ** Tyto zbraně mohou zvýšit riziko rozpoutání válečného konfliktu

19.  10.  2017 | Stanislav Mihulka | 20


Aktuální číslo časopisu Computer

Nový seriál o programování elektroniky

Otestovali jsme 17 bezdrátových sluchátek

Jak na nákup vánočních dárků ze zahraničí

4 tankové tiskárny v přímém souboji