uxthemeisx.pas

源代码

//  pszPropertyName     - name of the string property to retreive a value for
//  pszValueBuff        - receives the property string value
//  cchMaxValChars      - max chars allowed in pszValueBuff
//----------------------------------------------------------------------------------------------------------------------

const
  SZ_THDOCPROP_DISPLAYNAME               = 'DisplayName';
  SZ_THDOCPROP_CANONICALNAME             = 'ThemeName';
  SZ_THDOCPROP_TOOLTIP                   = 'ToolTip';
  SZ_THDOCPROP_AUTHOR                    = 'author';

var
  GetThemeDocumentationProperty: function(pszThemeName, pszPropertyName: LPCWSTR; pszValueBuff: LPWSTR;
    cchMaxValChars: Integer): HRESULT; stdcall;

//----------------------------------------------------------------------------------------------------------------------
//  Theme API Error Handling
//
//      All functions in the Theme API not returning an HRESULT (THEMEAPI_)
//      use the WIN32 function "SetLastError()" to record any call failures.
//
//      To retreive the error code of the last failure on the
//      current thread for these type of API's, use the WIN32 function
//      "GetLastError()".
//
//      All Theme API error codes (HRESULT's and GetLastError() values)
//      should be normal win32 errors which can be formatted into
//      strings using the Win32 API FormatMessage().
//----------------------------------------------------------------------------------------------------------------------

//----------------------------------------------------------------------------------------------------------------------
// DrawThemeParentBackground()
//                      - used by partially-transparent or alpha-blended
//                        child controls to draw the part of their parent
//                        that they appear in front of.
//
//  hwnd                - handle of the child control
//  hdc                 - hdc of the child control
//  prc                 - (optional) rect that defines the area to be
//                        drawn (CHILD coordinates)
//----------------------------------------------------------------------------------------------------------------------

var
  DrawThemeParentBackground: function(hwnd: HWND; hdc: HDC; prc: PRECT): HRESULT; stdcall;

//----------------------------------------------------------------------------------------------------------------------
//  EnableTheming()     - enables or disables themeing for the current user
//                        in the current and future sessions.
//
//  fEnable             - if FALSE, disable theming & turn themes off.
//                      - if TRUE, enable themeing and, if user previously
//                        had a theme active, make it active now.
//----------------------------------------------------------------------------------------------------------------------

var
  EnableTheming: function(fEnable: BOOL): HRESULT; stdcall;

implementation

//----------------------------------------------------------------------------------------------------------------------

const
  themelib = 'uxtheme.dll';

var
  ThemeLibrary: THandle;
  ReferenceCount: Integer;  // We have to keep track of several load/unload calls.

procedure FreeThemeLibrary;

begin
  if ReferenceCount > 0 then
    Dec(ReferenceCount);

  if (ThemeLibrary <> 0) and (ReferenceCount = 0) then
  begin
    FreeLibrary(ThemeLibrary);
    ThemeLibrary := 0;

    OpenThemeData := nil;
    CloseThemeData := nil;
    DrawThemeBackground := nil;
    DrawThemeText := nil;
    GetThemeBackgroundContentRect := nil;
    GetThemeBackgroundExtent := nil;
    GetThemePartSize := nil;
    GetThemeTextExtent := nil;
    GetThemeTextMetrics := nil;
    GetThemeBackgroundRegion := nil;
    HitTestThemeBackground := nil;
    DrawThemeEdge := nil;
    DrawThemeIcon := nil;
    IsThemePartDefined := nil;
    IsThemeBackgroundPartiallyTransparent := nil;
    GetThemeColor := nil;
    GetThemeMetric := nil;
    GetThemeString := nil;
    GetThemeBool := nil;
    GetThemeInt := nil;
    GetThemeEnumValue := nil;
    GetThemePosition := nil;
    GetThemeFont := nil;
    GetThemeRect := nil;
    GetThemeMargins := nil;
    GetThemeIntList := nil;
    GetThemePropertyOrigin := nil;
    SetWindowTheme := nil;
    GetThemeFilename := nil;
    GetThemeSysColor := nil;
    GetThemeSysColorBrush := nil;
    GetThemeSysBool := nil;
    GetThemeSysSize := nil;
    GetThemeSysFont := nil;
    GetThemeSysString := nil;
    GetThemeSysInt := nil;
    IsThemeActive := nil;
    IsAppThemed := nil;
    GetWindowTheme := nil;
    EnableThemeDialogTexture := nil;
    IsThemeDialogTextureEnabled := nil;
    GetThemeAppProperties := nil;
    SetThemeAppProperties := nil;
    GetCurrentThemeName := nil;
    GetThemeDocumentationProperty := nil;
    DrawThemeParentBackground := nil;
    EnableTheming := nil;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

function InitThemeLibrary: Boolean;

  function IsWindowsXP: Boolean;
  var
    Info: TOSVersionInfo;
  begin
    Result := False;
    Info.dwOSVersionInfoSize := SizeOf(Info);
    if GetVersionEx(Info) then
      if Info.dwPlatformId = VER_PLATFORM_WIN32_NT then
        if (Info.dwMajorVersion > 5) or
           ((Info.dwMajorVersion = 5) and (Info.dwMinorVersion >= 1)) then
          Result := True;
  end;

begin
  Inc(ReferenceCount);

  { Only attempt to load uxtheme.dll if running Windows XP or later; otherwise
    if uxtheme.dll happens to exist on Windows 2000 (it shouldn't unless a
    bugged installer put it there) we get a "RtlUnhandledExceptionFilter could
    not be located in the dynamic link library ntdll.dll" error message }
  if (ThemeLibrary = 0) and IsWindowsXP then
  begin
    ThemeLibrary := LoadLibrary(themelib);
    if ThemeLibrary <> 0 then
    begin
      OpenThemeData := GetProcAddress(ThemeLibrary, 'OpenThemeData');
      CloseThemeData := GetProcAddress(ThemeLibrary, 'CloseThemeData');
      DrawThemeBackground := GetProcAddress(ThemeLibrary, 'DrawThemeBackground');
      DrawThemeText := GetProcAddress(ThemeLibrary, 'DrawThemeText');
      GetThemeBackgroundContentRect := GetProcAddress(ThemeLibrary, 'GetThemeBackgroundContentRect');
      GetThemeBackgroundExtent := GetProcAddress(ThemeLibrary, 'GetThemeBackgroundContentRect');
      GetThemePartSize := GetProcAddress(ThemeLibrary, 'GetThemePartSize');
      GetThemeTextExtent := GetProcAddress(ThemeLibrary, 'GetThemeTextExtent');
      GetThemeTextMetrics := GetProcAddress(ThemeLibrary, 'GetThemeTextMetrics');
      GetThemeBackgroundRegion := GetProcAddress(ThemeLibrary, 'GetThemeBackgroundRegion');
      HitTestThemeBackground := GetProcAddress(ThemeLibrary, 'HitTestThemeBackground');
      DrawThemeEdge := GetProcAddress(ThemeLibrary, 'DrawThemeEdge');
      DrawThemeIcon := GetProcAddress(ThemeLibrary, 'DrawThemeIcon');
      IsThemePartDefined := GetProcAddress(ThemeLibrary, 'IsThemePartDefined');
      IsThemeBackgroundPartiallyTransparent := GetProcAddress(ThemeLibrary, 'IsThemeBackgroundPartiallyTransparent');
      GetThemeColor := GetProcAddress(ThemeLibrary, 'GetThemeColor');
      GetThemeMetric := GetProcAddress(ThemeLibrary, 'GetThemeMetric');
      GetThemeString := GetProcAddress(ThemeLibrary, 'GetThemeString');
      GetThemeBool := GetProcAddress(ThemeLibrary, 'GetThemeBool');
      GetThemeInt := GetProcAddress(ThemeLibrary, 'GetThemeInt');
      GetThemeEnumValue := GetProcAddress(ThemeLibrary, 'GetThemeEnumValue');
      GetThemePosition := GetProcAddress(ThemeLibrary, 'GetThemePosition');
      GetThemeFont := GetProcAddress(ThemeLibrary, 'GetThemeFont');
      GetThemeRect := GetProcAddress(ThemeLibrary, 'GetThemeRect');
      GetThemeMargins := GetProcAddress(ThemeLibrary, 'GetThemeMargins');
      GetThemeIntList := GetProcAddress(ThemeLibrary, 'GetThemeIntList');
      GetThemePropertyOrigin := GetProcAddress(ThemeLibrary, 'GetThemePropertyOrigin');
      SetWindowTheme := GetProcAddress(ThemeLibrary, 'SetWindowTheme');
      GetThemeFilename := GetProcAddress(ThemeLibrary, 'GetThemeFilename');
      GetThemeSysColor := GetProcAddress(ThemeLibrary, 'GetThemeSysColor');
      GetThemeSysColorBrush := GetProcAddress(ThemeLibrary, 'GetThemeSysColorBrush');
      GetThemeSysBool := GetProcAddress(ThemeLibrary, 'GetThemeSysBool');
      GetThemeSysSize := GetProcAddress(ThemeLibrary, 'GetThemeSysSize');
      GetThemeSysFont := GetProcAddress(ThemeLibrary, 'GetThemeSysFont');
      GetThemeSysString := GetProcAddress(ThemeLibrary, 'GetThemeSysString');
      GetThemeSysInt := GetProcAddress(ThemeLibrary, 'GetThemeSysInt');
      IsThemeActive := GetProcAddress(ThemeLibrary, 'IsThemeActive');
      IsAppThemed := GetProcAddress(ThemeLibrary, 'IsAppThemed');
      GetWindowTheme := GetProcAddress(ThemeLibrary, 'GetWindowTheme');
      EnableThemeDialogTexture := GetProcAddress(ThemeLibrary, 'EnableThemeDialogTexture');
      IsThemeDialogTextureEnabled := GetProcAddress(ThemeLibrary, 'IsThemeDialogTextureEnabled');
      GetThemeAppProperties := GetProcAddress(ThemeLibrary, 'GetThemeAppProperties');
      SetThemeAppProperties := GetProcAddress(ThemeLibrary, 'SetThemeAppProperties');
      GetCurrentThemeName := GetProcAddress(ThemeLibrary, 'GetCurrentThemeName');
      GetThemeDocumentationProperty := GetProcAddress(ThemeLibrary, 'GetThemeDocumentationProperty');
      DrawThemeParentBackground := GetProcAddress(ThemeLibrary, 'DrawThemeParentBackground');
      EnableTheming := GetProcAddress(ThemeLibrary, 'EnableTheming');
    end;
  end;
  Result := ThemeLibrary <> 0;
end;

//----------------------------------------------------------------------------------------------------------------------

function UseThemes: Boolean;

begin
  Result := ThemeLibrary <> 0;
  if Result then
    Result := IsAppThemed and IsThemeActive;
end;

//----------------------------------------------------------------------------------------------------------------------

{ Following commented out by JR. Depending on unit deinitialization order, the
  FreeThemeLibrary call below could be made while other units are still using
  the theme library. This happens with NewCheckListBox when Application.Run
  isn't called; this unit gets deinitialized before WizardForm and its
  TNewCheckListBoxes are destroyed. This resulted in an AV before because
  TNewCheckListBox.Destroy calls theme functions.
  And there's really no point in freeing a DLL during shutdown anyway; the
  system will do so automatically. }
(*
initialization
finalization
  while ReferenceCount > 0 do
    FreeThemeLibrary;
*)
end.