uxtheme.pas

Last change: 2008-02-03 This is the source code of KCeasy。

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

var
  GetCurrentThemeName: function(pszThemeFileName: LPWSTR; cchMaxNameChars: Integer; pszColorBuff: LPWSTR;
    cchMaxColorChars: Integer; pszSizeBuff: LPWSTR; cchMaxSizeChars: Integer): HRESULT; stdcall;
{$EXTERNALSYM GetCurrentThemeName}

//----------------------------------------------------------------------------------------------------------------------
//  GetThemeDocumentationProperty()
//                      - Get the value for the specified property name from
//                        the [documentation] section of the themes.ini file
//                        for the specified theme.  If the property has been
//                        localized in the theme files string table, the
//                        localized version of the property value is returned.
//
//  pszThemeFileName    - filename of the theme file to query
//  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               = WideString('DisplayName');
  {$EXTERNALSYM SZ_THDOCPROP_DISPLAYNAME}
  SZ_THDOCPROP_CANONICALNAME             = WideString('ThemeName');
  {$EXTERNALSYM SZ_THDOCPROP_CANONICALNAME}
  SZ_THDOCPROP_TOOLTIP                   = WideString('ToolTip');
  {$EXTERNALSYM SZ_THDOCPROP_TOOLTIP}
  SZ_THDOCPROP_AUTHOR                    = WideString('author');
  {$EXTERNALSYM SZ_THDOCPROP_AUTHOR}

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

//----------------------------------------------------------------------------------------------------------------------
//  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;
{$EXTERNALSYM DrawThemeParentBackground}

//----------------------------------------------------------------------------------------------------------------------
//  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;
{$EXTERNALSYM EnableTheming}

implementation

uses
  SyncObjs;

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

const
  themelib = 'uxtheme.dll';

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

procedure FreeThemeLibrary;

begin
  Lock.Enter;
  try
    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;
  finally
    Lock.Leave;
  end;
end;

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

function InitThemeLibrary: Boolean;

begin
  Lock.Enter;
  try
    Inc(ReferenceCount);

    if ThemeLibrary = 0 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, 'GetThemeBackgroundExtent');
        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;
  finally
    Lock.Leave;
  end;
end;

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

function UseThemes: Boolean;

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

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

initialization
  Lock := TCriticalSection.Create;
finalization
  while ReferenceCount > 0 do
    FreeThemeLibrary;
  Lock.Free;
end.