Entwickler-Ecke

Grafische Benutzeroberflächen (VCL & FireMonkey) - Erkennen, ob aktuelles Win.-Design Transparenzen unterstützt


CodexX - Mo 09.08.10 18:43
Titel: Erkennen, ob aktuelles Win.-Design Transparenzen unterstützt
Ich habe in meinem Program das XP-Manifest eingebunden und so sieht das Programm in XP, Vista und 7 immer entsprend des aktuellen Windows-Designs aus. Im Standard-Design sind die Groupboxen transparent und zeigen eine darunter liegende Grafik an.
Im Win2000-Design ist die Transparenz nicht vorhanden und die darunterliegende Grafik wird größtenteils überdeckt. Ich vermute, die Transparenz kann man nicht so einfach herzaubern, deshalb würde ich in dem Fall die Grafik lieber komplett ausblenden.

Ich kann zwar auf das verwendete Betriebssystem überprüfen und so Win2000 herausfiltern, aber das Problem ist, dass es auch bei XP, Vista und 7 einige Benutzer gibt, die den klassischen 2000 Look aktiviert haben. Dort fehlen die Transparenzen leider auch.

Kann man also irgendwie überprüfen, ob der klassische Win2000 Theme aktiviert ist und entsprechend Transparenzen fehlen?


Stundenplan - Mo 09.08.10 19:07

In HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Themes steht vllt. was brauchbares drin.


Gausi - Mo 09.08.10 19:13

Das sollte so gehen - wo ich den Code damals mal gefunden habe, weiß ich nicht mehr. ;-)

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
function _IsThemeActive: Boolean;
// Returns True if the user uses XP style
const
  themelib = 'uxtheme.dll';
type
  TIsThemeActive = function: BOOL; stdcall;
var
  IsThemeActive: TIsThemeActive;
  huxtheme: HINST;
begin
  Result := False;
  // Check if XP or later Version
  if (Win32Platform  = VER_PLATFORM_WIN32_NT) and
     (((Win32MajorVersion = 5and (Win32MinorVersion >= 1)) or
      (Win32MajorVersion > 5)) then
  begin
    huxtheme := LoadLibrary(themelib);
    if huxtheme <> 0 then
    begin
      try
        IsThemeActive := GetProcAddress(huxtheme, 'IsThemeActive');
        Result := IsThemeActive;
      finally
       if huxtheme > 0 then
          FreeLibrary(huxtheme);
      end;
    end;
  end;
end;


CodexX - Mo 09.08.10 19:28

Super! Hab's erfolgreich testen können.
Vielen Dank, Gausi! :)