{ ------------------------------------------------------------- }
{ Purpose : Next Common 6                                       }
{ By      : Bojan Nikolic                                       }
{ For     : BergSoft                                            }
{ ------------------------------------------------------------- }
{ Copyright (C) BergSoft.net 2011. All Rights Reserved.         }
{ ------------------------------------------------------------- }
{ mm/dd/yy comment                                              }
{ -------- ---------------------------------------------------- }
{ 10/24/11 Initial code                                         }
{ ------------------------------------------------------------- }
{ Todo :                                                        }
{ ------------------------------------------------------------- }
unit NxTheme6;

{$HPPEMIT ''}
{$HPPEMIT '#include "uxtheme.h"'}
{$HPPEMIT ''}

interface

uses
  { Standard }
  Windows, SysUtils;

type
  HIMAGELIST = THandle;
  HTHEME = THandle;
  {$EXTERNALSYM HTHEME}

var
  { External DLL's }
  OpenThemeData: function(hwnd: HWND; pszClassList: LPCWSTR): HTHEME; stdcall;
  {$EXTERNALSYM OpenThemeData}
  CloseThemeData: function(hTheme: HTHEME): HRESULT; stdcall;
  {$EXTERNALSYM CloseThemeData}
  DrawThemeBackground: function(hTheme: HTHEME; hdc: HDC; iPartId, iStateId: Integer;
    const Rect: TRect; pClipRect: PRect): HRESULT; stdcall;
  {$EXTERNALSYM DrawThemeBackground}
  DrawThemeEdge: function(hTheme: HTHEME; hdc: HDC; iPartId, iStateId: Integer;
	  const pDestRect: TRect; uEdge, uFlags: UINT; pContentRect: PRECT): HRESULT; stdcall;
  {$EXTERNALSYM DrawThemeEdge}
  GetThemeSysSize: function(hTheme: HTHEME; iSizeId: Integer): Integer; stdcall;
  {$EXTERNALSYM GetThemeSysSize}
  IsThemeActive: function: BOOL; stdcall;
  {$EXTERNALSYM IsThemeActive}
  IsAppThemed: function: BOOL; stdcall;
  {$EXTERNALSYM IsAppThemed}

  function Themed: Boolean;
  procedure InitThemes;
  procedure ReleaseThemes;

implementation

const
  UxThemeDll = 'uxtheme.dll';

var
	DllHandle: THandle;

procedure InitThemes;
begin
  if DllHandle = 0 then
  begin
    DllHandle := LoadLibrary(UxThemeDll);
    if DllHandle > 0 then
    begin
      CloseThemeData := GetProcAddress(DllHandle, 'CloseThemeData');
      DrawThemeBackground := GetProcAddress(DllHandle, 'DrawThemeBackground');
      DrawThemeEdge := GetProcAddress(DllHandle, 'DrawThemeEdge');
      GetThemeSysSize := GetProcAddress(DllHandle, 'GetThemeSysSize');
      IsThemeActive := GetProcAddress(DllHandle, 'IsThemeActive');
      IsAppThemed := GetProcAddress(DllHandle, 'IsAppThemed');
      OpenThemeData := GetProcAddress(DllHandle, 'OpenThemeData');
    end;
  end;
end;

function Themed: Boolean;
begin
	try
	  Result := (DllHandle > 0) and IsAppThemed and IsThemeActive;
  except
    raise Exception.Create('Error in Themes');
    Result := False;
  end;
end;

function IsThemesSupported: Boolean;
begin
  Result := (DllHandle > 0) and IsAppThemed;
end;

procedure ReleaseThemes;
begin
  if DllHandle <> 0 then
  begin
    FreeLibrary(DllHandle);
    DllHandle := 0;
    CloseThemeData := nil;
    DrawThemeBackground := nil;
    DrawThemeEdge := nil;
    GetThemeSysSize := nil;
    IsThemeActive := nil;
    IsAppThemed := nil;
    OpenThemeData := nil;
  end;
end;

initialization

InitThemes;

finalization

ReleaseThemes;

end.
