获取当前视觉主题名称

 

...get the name of the current visual style, the color scheme name and size name (XP)?

Author: David B. Ferguson  

uses ComObj, SyncObjs;

var

 GetCurrentThemeName: function (pszThemeFileName: LPWSTR; cchMaxNameChars: Integer;

   pszColorBuff: LPWSTR; cchMaxColorChars: Integer; pszSizeBuff: LPWSTR;

   cchMaxSizeChars: Integer): HRESULT; stdcall;

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));

     // show the the theme path and file name.

     ShowMessage(PWideChar(FileName));

     // show the color scheme name

     ShowMessage(PWideChar(ColorScheme));

     // show the size name

     ShowMessage(PWideChar(SizeName));

   end;

 finally

   FreeLibrary(hThemeLib);

 end;

end;