|
2014/9/27 (土) 22:03:31 Mr.XRAY |
実行時にランタイムテーマが有効かを判定する方法です．
uses に Themes を追加して，例えば以下のコードで判定できます．
procedure TForm1.Button1Click(Sender: TObject);
begin
if Themes.ThemeServices.Enabled then begin
ShowMessage('テーマ有効');
end else begin
ShowMessage('テーマ無効');
end;
end;
stackoverflow に次のようなコードがありました．
これを利用したコードです．
同じく uses に Themes が必要です．
http://stackoverflow.com/questions/2879820/importing-specific-in-my-case-themes-themesservice-themesenabled-function
function ThemesEnabled :Boolean;
const
ComCtlVersionIE6 = $00060000;
var
ThemeLib : THandle;
IsThemeActive : function: Boolean; stdcall;
IsAppThemed : function: Boolean; stdcall;
begin
Result := GetFileVersion('comctl32.dll') >= ComCtlVersionIE6;
if not Result then exit;
ThemeLib := LoadLibrary('uxtheme.dll');
try
if ThemeLib > 0 then begin
IsAppThemed := GetProcAddress(ThemeLib, 'IsAppThemed');
IsThemeActive := GetProcAddress(ThemeLib, 'IsThemeActive');
Result := IsAppThemed and IsThemeActive;
end else begin
Result:=False;
end;
finally
FreeLibrary(ThemeLib);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if ThemesEnabled then begin
ShowMessage('テーマ有効');
end else begin
ShowMessage('テーマ無効');
end;
end;
 |
|
