advuxtheme.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

unit AdvUxTheme;

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

interface

uses
  Windows, CommCtrl;

procedure FreeThemeLibrary;
function InitThemeLibrary: Boolean;
function UseThemes: Boolean;

function GetFileVersion(const AFileName: string): Cardinal;

type
  HTHEME = THANDLE;
  {$EXTERNALSYM HTHEME}
  

{$IFNDEF DELPHI2007_LVL}
const
  ComCtlVersionIE6 = $00060000;

  TMT_CAPTIONFONT = 801;

  EDITPartFiller0 = 0;
  {$EXTERNALSYM EDITPartFiller0}
  EP_EDITTEXT = 1;
  {$EXTERNALSYM EP_EDITTEXT}
  EP_CARET = 2;
  {$EXTERNALSYM EP_CARET}

var
  OpenThemeData: function(hwnd: HWND; pszClassList: LPCWSTR): HTHEME; stdcall;
  {$EXTERNALSYM OpenThemeData}
  CloseThemeData: function(hTheme: HTHEME): HRESULT; stdcall;
  {$EXTERNALSYM CloseThemeData}
  GetThemeSysFont: function(hTheme: HTHEME; iFontId: Integer;
    var plf: LOGFONT): HRESULT; stdcall;
  {$EXTERNALSYM GetThemeSysFont}

  IsThemeActive: function: BOOL; stdcall;
  {$EXTERNALSYM IsThemeActive}
  IsAppThemed: function: BOOL; stdcall;
  {$EXTERNALSYM IsAppThemed}
{$ENDIF}

// ---------------------------------------------------------------------------
type
  {$EXTERNALSYM DTT_CALLBACK_PROC}
  DTT_CALLBACK_PROC = function(hdc: HDC; pszText: LPWSTR; cchText: Integer;
    prc: PRect; dwFlags: UINT; lParam: LPARAM): Integer; stdcall;
  TFNDTTCallbackProc = DTT_CALLBACK_PROC;


{$IFNDEF DELPHI2007_LVL}
type
  _MARGINS = record
    cxLeftWidth: Integer;      // width of left border that retains its size
    cxRightWidth: Integer;     // width of right border that retains its size
    cyTopHeight: Integer;      // height of top border that retains its size
    cyBottomHeight: Integer;   // height of bottom border that retains its size
  end;
  {$EXTERNALSYM _MARGINS}
  MARGINS = _MARGINS;
  {$EXTERNALSYM MARGINS}
  PMARGINS = ^MARGINS;
  {$EXTERNALSYM PMARGINS}
  TMargins = MARGINS;
{$ENDIF}

// ---- bits used in dwFlags of DTTOPTS ----
const
  {$EXTERNALSYM DTT_TEXTCOLOR}
  DTT_TEXTCOLOR       = 1 shl 0;        // crText has been specified
  {$EXTERNALSYM DTT_BORDERCOLOR}
  DTT_BORDERCOLOR     = 1 shl 1;        // crBorder has been specified
  {$EXTERNALSYM DTT_SHADOWCOLOR}
  DTT_SHADOWCOLOR     = 1 shl 2;        // crShadow has been specified
  {$EXTERNALSYM DTT_SHADOWTYPE}
  DTT_SHADOWTYPE      = 1 shl 3;        // iTextShadowType has been specified
  {$EXTERNALSYM DTT_SHADOWOFFSET}
  DTT_SHADOWOFFSET    = 1 shl 4;        // ptShadowOffset has been specified
  {$EXTERNALSYM DTT_BORDERSIZE}
  DTT_BORDERSIZE      = 1 shl 5;        // iBorderSize has been specified
  {$EXTERNALSYM DTT_FONTPROP}
  DTT_FONTPROP        = 1 shl 6;        // iFontPropId has been specified
  {$EXTERNALSYM DTT_COLORPROP}
  DTT_COLORPROP       = 1 shl 7;        // iColorPropId has been specified
  {$EXTERNALSYM DTT_STATEID}
  DTT_STATEID         = 1 shl 8;        // IStateId has been specified
  {$EXTERNALSYM DTT_CALCRECT}
  DTT_CALCRECT        = 1 shl 9;        // Use pRect as and in/out parameter
  {$EXTERNALSYM DTT_APPLYOVERLAY}
  DTT_APPLYOVERLAY    = 1 shl 10;       // fApplyOverlay has been specified
  {$EXTERNALSYM DTT_GLOWSIZE}
  DTT_GLOWSIZE        = 1 shl 11;       // iGlowSize has been specified
  {$EXTERNALSYM DTT_CALLBACK}
  DTT_CALLBACK        = 1 shl 12;       // pfnDrawTextCallback has been specified
  {$EXTERNALSYM DTT_COMPOSITED}
  DTT_COMPOSITED      = 1 shl 13;       // Draws text with antialiased alpha (needs a DIB section)
  {$EXTERNALSYM DTT_VALIDBITS}
  DTT_VALIDBITS       = DTT_TEXTCOLOR or
                        DTT_BORDERCOLOR or
                        DTT_SHADOWCOLOR or
                        DTT_SHADOWTYPE or
                        DTT_SHADOWOFFSET or
                        DTT_BORDERSIZE or
                        DTT_FONTPROP or
                        DTT_COLORPROP or
                        DTT_STATEID or
                        DTT_CALCRECT or
                        DTT_APPLYOVERLAY or
                        DTT_GLOWSIZE or
                        DTT_COMPOSITED;

type
  {$EXTERNALSYM PDTTOPTS}
  PDTTOPTS = ^DTTOPTS;
  {$EXTERNALSYM DTTOPTS}
  DTTOPTS = packed record
    dwSize: DWORD;                          // size of the struct
    dwFlags: DWORD;                         // which options have been specified
    crText: COLORREF;                       // color to use for text fill
    crBorder: COLORREF;                     // color to use for text outline
    crShadow: COLORREF;                     // color to use for text shadow
    iTextShadowType: Integer;               // TST_SINGLE or TST_CONTINUOUS
    ptShadowOffset: TPoint;                 // where shadow is drawn (relative to text)
    iBorderSize: Integer;                   // Border radius around text
    iFontPropId: Integer;                   // Font property to use for the text instead of TMT_FONT
    iColorPropId: Integer;                  // Color property to use for the text instead of TMT_TEXTCOLOR
    iStateId: Integer;                      // Alternate state id
    fApplyOverlay: BOOL;                    // Overlay text on top of any text effect?
    iGlowSize: Integer;                     // Glow radious around text
    pfnDrawTextCallback: TFNDTTCallbackProc;// Callback for DrawText
    lParam: LPARAM;                         // Parameter for callback
  end;
  _DTTOPTS = DTTOPTS;
  TDTTOpts = DTTOPTS;

{$EXTERNALSYM DrawThemeTextEx}
function DrawThemeTextEx(hTheme: HTHEME; hdc: HDC; iPartId: Integer;
  iStateId: Integer; pszText: LPCWSTR; cchText: Integer; dwTextFlags: DWORD;
  pRect: PRect; var pOptions: TDTTOpts): HResult;

implementation

uses
  SyncObjs;

const
  themelib = 'uxtheme.dll';

var
  ThemeLibrary: THandle;
  ReferenceCount: Integer;
  Lock: TCriticalSection;

  _DrawThemeTextEx: function(hTheme: HTHEME; hdc: HDC; iPartId: Integer;
    iStateId: Integer; pszText: LPCWSTR; cchText: Integer;
    dwTextFlags: DWORD; pRect: PRect; var pOptions: TDTTOpts): HResult; stdcall;

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

function DrawThemeTextEx(hTheme: HTHEME; hdc: HDC; iPartId: Integer;
  iStateId: Integer; pszText: LPCWSTR; cchText: Integer; dwTextFlags: DWORD;
  pRect: PRect; var pOptions: TDTTOpts): HResult;
begin
  if Assigned(_DrawThemeTextEx) then
    Result := _DrawThemeTextEx(hTheme, hdc, iPartId, iStateId, pszText, cchText,
      dwTextFlags, pRect, pOptions)
  else
  begin
    Result := E_NOTIMPL;
    if ThemeLibrary > 0 then
    begin
      _DrawThemeTextEx := GetProcAddress(ThemeLibrary, 'DrawThemeTextEx'); // Do not localize
      if Assigned(_DrawThemeTextEx) then
        Result := _DrawThemeTextEx(hTheme, hdc, iPartId, iStateId, pszText,
          cchText, dwTextFlags, pRect, pOptions);
    end;
  end;
end;

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

procedure FreeThemeLibrary;
begin
  Lock.Enter;
  try
    if ReferenceCount > 0 then
      Dec(ReferenceCount);

    if (ThemeLibrary <> 0) and (ReferenceCount = 0) then
    begin
      FreeLibrary(ThemeLibrary);
      ThemeLibrary := 0;
    {$IFNDEF DELPHI2007_LVL}
      OpenThemeData := nil;
      CloseThemeData := nil;
      IsAppThemed := nil;
      IsThemeActive := nil;
      GetThemeSysFont := nil;
    {$ENDIF}
    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
      {$IFNDEF DELPHI2007_LVL}
        OpenThemeData := GetProcAddress(ThemeLibrary, 'OpenThemeData');
        CloseThemeData := GetProcAddress(ThemeLibrary, 'CloseThemeData');
        IsAppThemed := GetProcAddress(ThemeLibrary, 'IsAppThemed');
        IsThemeActive := GetProcAddress(ThemeLibrary, 'IsThemeActive');
        GetThemeSysFont := GetProcAddress(ThemeLibrary, 'GetThemeSysFont');
      {$ENDIF}
      end;
    end;
    Result := ThemeLibrary > 0;
  finally
    Lock.Leave;
  end;
end;

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

{$IFNDEF DELPHI2007_LVL}
function UseThemes: Boolean;
begin
  if (ThemeLibrary > 0) then
    Result := IsAppThemed and IsThemeActive
  else
    Result := False;
end;

// TMSSysUtils
function GetFileVersion(const AFileName: string): Cardinal;
var
  FileName: string;
  InfoSize, Wnd: DWORD;
  VerBuf: Pointer;
  FI: PVSFixedFileInfo;
  VerSize: DWORD;
begin
  Result := Cardinal(-1);
  // GetFileVersionInfo modifies the filename parameter data while parsing.
  // Copy the string const into a local variable to create a writeable copy.
  FileName := AFileName;
  UniqueString(FileName);
  InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
  if InfoSize <> 0 then
  begin
    GetMem(VerBuf, InfoSize);
    try
      if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
        if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
          Result:= FI.dwFileVersionMS;
    finally
      FreeMem(VerBuf);
    end;
  end;
end;

{$ENDIF}

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