lazarus-ccr/components/jvcllaz/run/JvCore/jvthemes.pas

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvThemes.PAS, released on 2003-09-25

The Initial Developers of the Original Code are: Andreas Hausladen <Andreas dott Hausladen att gmx dott de>
All Rights Reserved.

Contributors:

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Known Issues:
-----------------------------------------------------------------------------}
// $Id$

unit JvThemes;

{$mode objfpc}{$H+}

{$DEFINE JVCLThemesEnabled}
{$DEFINE COMPILER7_UP}


interface

uses
  LCLType, LCLIntf, LMessages,
  //Types,
  SysUtils, Classes,
  {$IFDEF JVCLThemesEnabled}
  Themes,
  {$ENDIF JVCLThemesEnabled}
  Controls, Forms, Graphics, Buttons;

(************************************** NOT CONVERTED ***
const
 // Add a message handler to a component that is themed by the ThemeManager but
 // should not be themed.
  CM_DENYSUBCLASSING = CM_BASE + 2000; // from ThemeMgr.pas

type
  TCMDenySubClassing = TMessage;

{$IFDEF JVCLThemesEnabled}

{$IFNDEF COMPILER16_UP}
type
  TElementSize = (esMinimum, esActual, esStretch);
{$ELSE}
  esMinimum = TElementSize.esStretch;
  esActual = TElementSize.esActual;
  esStretch = TElementSize.esStretch;
{$ENDIF ~COMPILER16_UP}
************)
type
  TThemeServicesEx = class(TThemeServices)
    (*************** NOT CONVERTED ***
  {$IFNDEF COMPILER16_UP}
  private
    function DoGetElementSize(DC: HDC; Details: TThemedElementDetails; Rect: PRect;
      ElementSize: TElementSize; out Size: TSize): Boolean;
  {$ENDIF ~COMPILER16_UP}
  *******************)
  public
    (****************
    {$IFNDEF COMPILER7_UP}
    procedure ApplyThemeChange;
    {$ENDIF ~COMPILER7_UP}
    {$IFNDEF COMPILER16_UP}
    function GetElementContentRect(DC: HDC; Details: TThemedElementDetails;
      const BoundingRect: TRect; out AContentRect: TRect): Boolean;
    function GetElementSize(DC: HDC; Details: TThemedElementDetails; ElementSize: TElementSize;
      out Size: TSize): Boolean; overload;
    function GetElementSize(DC: HDC; Details: TThemedElementDetails; const Rect: TRect;
      ElementSize: TElementSize; out Size: TSize): Boolean; overload;
      ********************)
    function IsSystemStyle: Boolean;
    function Enabled: Boolean;
    function Available: Boolean;
    (********************
    function GetSystemColor(Color: TColor): TColor;
    {$ENDIF ~COMPILER16_UP}
    ****************)
  end;

function ThemeServices: TThemeServicesEx;
function StyleServices: TThemeServicesEx;

(******************* NOT CONVERTED
{ PaintControlBorder paints the themed border for WinControls only when they
  have the WS_EX_CLIENTEDGE. }
procedure PaintControlBorder(Control: TWinControl);

{ DrawThemedBorder draws a teEditTextNormal element (border) to the DC. It uses
  the Control's BoundsRect. DrawThemedBorder forces border painting. }
procedure DrawThemedBorder(Control: TControl);

{$ENDIF JVCLThemesEnabled}
**********************)

type
  TJvThemeStyle = TControlStyle;
{
  Instead of the ControlStyle property you should use the following functions:

    ControlStyle := ControlStyle + [csXxx]; -> IncludeThemeStyle(Self, [csXxx]);
    ControlStyle := ControlStyle - [csXxx]; -> ExcludeThemeStyle(Self, [csXxx]);
    if csXxx in ControlStyle then           -> if csXxx in GetThemeStyle(Self) then

}
procedure IncludeThemeStyle(Control: TControl; Style: TJvThemeStyle);
procedure ExcludeThemeStyle(Control: TControl; Style: TJvThemeStyle);
function GetThemeStyle(Control: TControl): TJvThemeStyle;

{ DrawThemedBackground fills R with Canvas.Brush.Color/Color. If the control uses
  csParentBackground and the color is that of it's parent the Rect is not filled
  because then it is done by the JvThemes/VCL7. }
procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas;
  const R: TRect; NeedsParentBackground: Boolean = True); overload;
procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas;
  const R: TRect; Color: TColor; NeedsParentBackground: Boolean = True); overload;
procedure DrawThemedBackground(Control: TControl; DC: HDC; const R: TRect;
  Brush: HBRUSH; NeedsParentBackground: Boolean = True); overload;

(***************************** NOT CONVERTED ***
{ DrawThemesFrameControl draws a themed frame control when theming is enabled. }
function DrawThemedFrameControl(DC: HDC; const Rect: TRect; uType, uState: UINT): BOOL;
*)

{ PerformEraseBackground sends a WM_ERASEBKGND message to the Control's parent. }
procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint); overload;
procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint; const R: TRect); overload;
procedure PerformEraseBackground(Control: TControl; DC: HDC); overload;
procedure PerformEraseBackground(Control: TControl; DC: HDC; const R: TRect); overload;


(***************************** NOT CONVERTED ***
{ DrawThemedButtonFace draws a themed button when theming is enabled. }
function DrawThemedButtonFace(Control: TControl; Canvas: TCanvas; const Client: TRect;
  BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown,
  IsFocused, IsHot: Boolean): TRect;

{ IsMouseOver returns True if the mouse is over the control. }
function IsMouseOver(Control: TControl): Boolean;

// ~COMPILER7_UP: These functions are helpers for Delphi 6 that doesn't have the csParentPackground flag.
{ GetParentBackground returns True if the Control has the csParentPackground
  ControlStyle }
function GetParentBackground(Control: TWinControl): Boolean;
{ SetParentBackground sets the Control's csParentPackground ControlStyle }
procedure SetParentBackground(Control: TWinControl; Value: Boolean);

{ GetGlassPaintFlag returns True if csGlassPaint in ControlState }
function GetGlassPaintFlag(AControl: TControl): Boolean;
{ ControlInGlassPaint returns True if the Control is painted on a glass area }
function ControlInGlassPaint(AControl: TControl): Boolean;
{ DrawGlassableText paints text to a device context with support of PaintOnGlass }
procedure DrawGlassableText(DC: HDC; const Text: string; var TextRect: TRect; TextFlags: Cardinal;
  PaintOnGlass: Boolean = False);
{ DrawGlassableImageList paint a transparent imagelist image to the canvas with
  support of PaintOnGlass }
procedure DrawGlassableImageList(ImageList: HIMAGELIST; Index: Integer; Dest: HDC; X, Y: Integer;
  Style: UINT; PaintOnGlass: Boolean = False);

******************)

implementation
(*
uses
{$IFNDEF COMPILER10_UP}
  JclSysUtils,
{$ENDIF ~COMPILER10_UP}
  JclSysInfo;
  *)

type
  TWinControlThemeInfo = class(TWinControl)
  public
    property Color;
  end;

procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas;
  const R: TRect; NeedsParentBackground: Boolean = True);
begin
  DrawThemedBackground(Control, Canvas, R, Canvas.Brush.Color, NeedsParentBackground);
end;

procedure DrawThemedBackground(Control: TControl; Canvas: TCanvas;
  const R: TRect; Color: TColor; NeedsParentBackground: Boolean = True);
var
  Cl: TColor;
begin
  {$IFDEF JVCLThemesEnabled}
  if StyleServices.Enabled and
     (Control.Parent <> nil) and
     ((Color = TWinControlThemeInfo(Control.Parent).Color) or
      (ColorToRGB(Color) = ColorToRGB(TWinControlThemeInfo(Control.Parent).Color))) and
     (not NeedsParentBackground or (csParentBackground in GetThemeStyle(Control))) then
  begin
    if Control is TWinControl then
    begin
      if TWinControl(Control).DoubleBuffered then
        PerformEraseBackground(Control, Canvas.Handle, R)
      else
        StyleServices.DrawParentBackground(TWinControl(Control).Handle, Canvas.Handle, nil,
          False, @R);
    end
    else
      PerformEraseBackground(Control, Canvas.Handle, R)
  end
  else
  {$ENDIF JVCLThemesEnabled}
  begin
    {$IFDEF JVCLStylesEnabled}
    if StyleServices.Enabled and TStyleManager.IsCustomStyleActive then
      Color := StyleServices.GetSystemColor(Color);
    {$ENDIF JVCLStylesEnabled}
    Cl := Canvas.Brush.Color;
    if Cl <> Color then
      Canvas.Brush.Color := Color;
    Canvas.FillRect(R);
    if Cl <> Canvas.Brush.Color then
      Canvas.Brush.Color := Cl;
  end;
end;

procedure DrawThemedBackground(Control: TControl; DC: HDC; const R: TRect;
  Brush: HBRUSH; NeedsParentBackground: Boolean = True);
{$IFDEF JVCLThemesEnabled}
var
  LogBrush: TLogBrush;
{$ENDIF JVCLThemesEnabled}
begin
  {$IFDEF JVCLThemesEnabled}
  GetObject(Brush, SizeOf(LogBrush), @LogBrush);
  if StyleServices.Enabled and
     (Control.Parent <> nil) and
     (LogBrush.lbColor = Cardinal(ColorToRGB(TWinControlThemeInfo(Control.Parent).Color))) and
     (not NeedsParentBackground or (csParentBackground in GetThemeStyle(Control))) then
  begin
    if Control is TWinControl then
    begin
      if TWinControl(Control).DoubleBuffered then
        PerformEraseBackground(Control, DC, R)
      else
        StyleServices.DrawParentBackground(TWinControl(Control).Handle, DC, nil, False, @R);
    end
    else
      PerformEraseBackground(Control, DC, R)
  end
  else
  {$ENDIF JVCLThemesEnabled}
    FillRect(DC, R, Brush);
end;

(************************ NOT CONVERTED ***
function DrawThemedFrameControl(DC: HDC; const Rect: TRect; uType, uState: UINT): BOOL;
{$IFDEF JVCLThemesEnabled}
const
  Mask = $00FF;
var
  Btn: TThemedButton;
  ComboBox: TThemedComboBox;
  ScrollBar: TThemedScrollBar;
  R: TRect;
  Details: TThemedElementDetails;
{$ENDIF JVCLThemesEnabled}
begin
  Result := False;
  {$IFDEF JVCLThemesEnabled}
  if StyleServices.Enabled then
  begin
    R := Rect;
    case uType of
      DFC_BUTTON:
        case uState and Mask of
          DFCS_BUTTONPUSH:
            begin
              if uState and (DFCS_TRANSPARENT or DFCS_FLAT) = 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  Btn := tbPushButtonDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  Btn := tbPushButtonPressed
                else
                if uState and DFCS_HOT <> 0 then
                  Btn := tbPushButtonHot
                else
                if uState and DFCS_MONO <> 0 then
                  Btn := tbPushButtonDefaulted
                else
                  Btn := tbPushButtonNormal;

                Details := StyleServices.GetElementDetails(Btn);
                StyleServices.DrawElement(DC, Details, R);
                Result := True;
              end;
            end;
          DFCS_BUTTONCHECK:
            begin
              if uState and DFCS_CHECKED <> 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  Btn := tbCheckBoxCheckedDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  Btn := tbCheckBoxCheckedPressed
                else
                if uState and DFCS_HOT <> 0 then
                  Btn := tbCheckBoxCheckedHot
                else
                  Btn := tbCheckBoxCheckedNormal;
              end
              else
              if uState and DFCS_MONO <> 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  Btn := tbCheckBoxMixedDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  Btn := tbCheckBoxMixedPressed
                else
                if uState and DFCS_HOT <> 0 then
                  Btn := tbCheckBoxMixedHot
                else
                  Btn := tbCheckBoxMixedNormal;
              end
              else
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  Btn := tbCheckBoxUncheckedDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  Btn := tbCheckBoxUncheckedPressed
                else
                if uState and DFCS_HOT <> 0 then
                  Btn := tbCheckBoxUncheckedHot
                else
                  Btn := tbCheckBoxUncheckedNormal;
              end;
              Details := StyleServices.GetElementDetails(Btn);
              StyleServices.DrawElement(DC, Details, R);
              Result := True;
            end;
          DFCS_BUTTONRADIO:
            begin
              if uState and DFCS_CHECKED <> 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  Btn := tbRadioButtonCheckedDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  Btn := tbRadioButtonCheckedPressed
                else
                if uState and DFCS_HOT <> 0 then
                  Btn := tbRadioButtonCheckedHot
                else
                  Btn := tbRadioButtonCheckedNormal;
              end
              else
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  Btn := tbRadioButtonUncheckedDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  Btn := tbRadioButtonUncheckedPressed
                else
                if uState and DFCS_HOT <> 0 then
                  Btn := tbRadioButtonUncheckedHot
                else
                  Btn := tbRadioButtonUncheckedNormal;
              end;
              Details := StyleServices.GetElementDetails(Btn);
              StyleServices.DrawElement(DC, Details, R);
              Result := True;
            end;
        end;
      DFC_SCROLL:
        begin
          case uState and Mask of
            DFCS_SCROLLCOMBOBOX:
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  ComboBox := tcDropDownButtonDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  ComboBox := tcDropDownButtonPressed
                else
                if uState and DFCS_HOT <> 0 then
                  ComboBox := tcDropDownButtonHot
                else
                  ComboBox := tcDropDownButtonNormal;

                Details := StyleServices.GetElementDetails(ComboBox);
                StyleServices.DrawElement(DC, Details, R);
                Result := True;
              end;
            DFCS_SCROLLUP:
              if uState and (DFCS_TRANSPARENT {or DFCS_FLAT}) = 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  ScrollBar := tsArrowBtnUpDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  ScrollBar := tsArrowBtnUpPressed
                else
                if uState and DFCS_HOT <> 0 then
                  ScrollBar := tsArrowBtnUpHot
                else
                  ScrollBar := tsArrowBtnUpNormal;

                Details := StyleServices.GetElementDetails(ScrollBar);
                StyleServices.DrawElement(DC, Details, R);
                Result := True;
              end;
            DFCS_SCROLLDOWN:
              if uState and (DFCS_TRANSPARENT {or DFCS_FLAT}) = 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  ScrollBar := tsArrowBtnDownDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  ScrollBar := tsArrowBtnDownPressed
                else
                if uState and DFCS_HOT <> 0 then
                  ScrollBar := tsArrowBtnDownHot
                else
                  ScrollBar := tsArrowBtnDownNormal;

                Details := StyleServices.GetElementDetails(ScrollBar);
                StyleServices.DrawElement(DC, Details, R);
                Result := True;
              end;
            DFCS_SCROLLLEFT:
              if uState and (DFCS_TRANSPARENT {or DFCS_FLAT}) = 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  ScrollBar := tsArrowBtnLeftDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  ScrollBar := tsArrowBtnLeftPressed
                else
                if uState and DFCS_HOT <> 0 then
                  ScrollBar := tsArrowBtnLeftHot
                else
                  ScrollBar := tsArrowBtnLeftNormal;

                Details := StyleServices.GetElementDetails(ScrollBar);
                StyleServices.DrawElement(DC, Details, R);
                Result := True;
              end;
            DFCS_SCROLLRIGHT:
              if uState and (DFCS_TRANSPARENT {or DFCS_FLAT}) = 0 then
              begin
                if uState and DFCS_INACTIVE <> 0 then
                  ScrollBar := tsArrowBtnRightDisabled
                else
                if uState and DFCS_PUSHED <> 0 then
                  ScrollBar := tsArrowBtnRightPressed
                else
                if uState and DFCS_HOT <> 0 then
                  ScrollBar := tsArrowBtnRightHot
                else
                  ScrollBar := tsArrowBtnRightNormal;

                Details := StyleServices.GetElementDetails(ScrollBar);
                StyleServices.DrawElement(DC, Details, R);
                Result := True;
              end;
          end;
        end;
    end;
  end;
  {$ENDIF JVCLThemesEnabled}

  if not Result then
    Result := DrawFrameControl(DC, Rect, uType, uState);
end;
*)

function IsInvalidRect(const R: TRect): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
begin
  Result := (R.Left = MaxInt) and (R.Top = MaxInt) and (R.Right = MaxInt) and (R.Bottom = MaxInt);
end;

procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint);
begin
  PerformEraseBackground(Control, DC, Offset, Rect(MaxInt, MaxInt, MaxInt, MaxInt));
end;

procedure PerformEraseBackground(Control: TControl; DC: HDC; Offset: TPoint; const R: TRect);
var
  WindowOrg: TPoint = (X:0; Y:0);
  OrgRgn, Rgn: THandle;
  {$IFDEF COMPILER16_UP}
  OldPen: HPEN;
  OldBrush: HBRUSH;
  OldFont: HFONT;
  OldTextColor: TColorRef;
  OldBkMode: Integer;
  {$ENDIF COMPILER16_UP}
begin
  if Control.Parent <> nil then
  begin
    if (Offset.X <> 0) and (Offset.Y <> 0) then
    begin
      GetWindowOrgEx(DC, WindowOrg);
      if Control is TGraphicControl then
        SetWindowOrgEx(DC, -Offset.X, -Offset.Y, nil)
      else
        SetWindowOrgEx(DC, WindowOrg.X + Offset.X, WindowOrg.Y + Offset.Y, nil);
    end;

    OrgRgn := 0;
    if not IsInvalidRect(R) then
    begin
      OrgRgn := CreateRectRgn(0, 0, 1, 1);
      if GetClipRgn(DC, OrgRgn) = 0 then
      begin
        DeleteObject(OrgRgn);
        OrgRgn := 0;
      end;
      Rgn := CreateRectRgnIndirect(R);
      SelectClipRgn(DC, Rgn);
      DeleteObject(Rgn);
    end;

    try
      {$IFDEF COMPILER16_UP}
      // Delphi XE2's Style-Engine has a bug in the TStyleHook.WMEraseBkgnd that replaces the
      // selected GDI objects with the TCanvas default objects ("System" font, ...).
      // We need to repair the damage in order to have the same behavior of the native theming API.
      // General rule for WM_ERASEBKGND: Return the DC in the state in that it was when the function
      // was called.
      OldPen := 0;
      OldBrush := 0;
      OldFont := 0;
      OldTextColor := 0;
      OldBkMode := 0;
      if StyleServices.Enabled and not StyleServices.IsSystemStyle then
      begin
        OldPen := GetCurrentObject(DC, OBJ_PEN);
        OldBrush := GetCurrentObject(DC, OBJ_BRUSH);
        OldFont := GetCurrentObject(DC, OBJ_FONT);
        OldTextColor := GetTextColor(DC);
        OldBkMode := GetBkMode(DC);
      end;
      {$ENDIF COMPILER16_UP}
      Control.Parent.Perform(LM_ERASEBKGND, DC, DC); // force redraw
      {$IFDEF COMPILER16_UP}
      if StyleServices.Enabled and not StyleServices.IsSystemStyle then
      begin
        if GetCurrentObject(DC, OBJ_PEN) <> OldPen then
          SelectObject(DC, OldPen);
        if GetCurrentObject(DC, OBJ_BRUSH) <> OldBrush then
          SelectObject(DC, OldBrush);
        if GetCurrentObject(DC, OBJ_FONT) <> OldFont then
          SelectObject(DC, OldFont);
        if GetTextColor(DC) <> OldTextColor then
          SetTextColor(DC, OldTextColor);
        if GetBkMode(DC) <> OldBkMode then
          SetBkMode(DC, OldBkMode);
      end;
      {$ENDIF COMPILER16_UP}
    finally
      if (Offset.X <> 0) and (Offset.Y <> 0) then
        SetWindowOrgEx(DC, WindowOrg.X, WindowOrg.Y, nil);

      if OrgRgn <> 0 then
      begin
        SelectClipRgn(DC, OrgRgn);
        DeleteObject(OrgRgn);
      end;
    end;
  end;
end;

procedure PerformEraseBackground(Control: TControl; DC: HDC);
begin
  PerformEraseBackground(Control, DC, Point(Control.Left, Control.Top));
end;

procedure PerformEraseBackground(Control: TControl; DC: HDC; const R: TRect);
begin
  PerformEraseBackground(Control, DC, Point(Control.Left, Control.Top), R);
end;

(***************************** NOT CONVERTED ***
function DrawThemedButtonFace(Control: TControl; Canvas: TCanvas;
  const Client: TRect; BevelWidth: Integer; Style: TButtonStyle;
  IsRounded, IsDown, IsFocused, IsHot: Boolean): TRect;
{$IFDEF JVCLThemesEnabled}
var
  Btn: TThemedButton;
  Details: TThemedElementDetails;
{$ENDIF JVCLThemesEnabled}
begin
  {$IFDEF JVCLThemesEnabled}
  if (Style <> bsWin31) and StyleServices.Enabled then
  begin
    Result := Client;

    if IsDown then
      Btn := tbPushButtonPressed
    else
    if IsFocused then
      Btn := tbPushButtonDefaulted
    else
    if IsHot then
      Btn := tbPushButtonHot
    else
      Btn := tbPushButtonNormal;

    Details := StyleServices.GetElementDetails(Btn);
    StyleServices.DrawElement(Canvas.Handle, Details, Result);
    StyleServices.GetElementContentRect(Canvas.Handle, Details, Client, Result);

    if IsFocused then
      DrawFocusRect(Canvas.Handle, Result);

    InflateRect(Result, -BevelWidth, -BevelWidth);
  end
  else
  {$ENDIF JVCLThemesEnabled}
    Result := DrawButtonFace(Canvas, Client, BevelWidth, Style, IsRounded, IsDown, IsFocused);
end;

function IsMouseOver(Control: TControl): Boolean;
var
  Pt: TPoint;
begin
  Pt := Control.ScreenToClient(Mouse.CursorPos);
  Result := PtInRect(Control.ClientRect, Pt);
end;

function GetParentBackground(Control: TWinControl): Boolean;
begin
  Result := csParentBackground in GetThemeStyle(Control);
end;

procedure SetParentBackground(Control: TWinControl; Value: Boolean);
begin
  if Value <> GetParentBackground(Control) then
  begin
    if Value then
      IncludeThemeStyle(Control, [csParentBackground])
    else
      ExcludeThemeStyle(Control, [csParentBackground]);
    Control.Invalidate;
  end;
end;

function GetGlassPaintFlag(AControl: TControl): Boolean;
{$IFDEF COMPILER11}
var
  Form: TCustomForm;
{$ENDIF COMPILER11}
begin
  {$IFDEF COMPILER12_UP}
  Result := csGlassPaint in AControl.ControlState;
  {$ELSE}
  Result := False;
  {$IFDEF COMPILER11}
  Form := GetParentForm(AControl);
  if (Form <> nil) and Form.GlassFrame.Enabled then
    Result := Form.GlassFrame.IntersectsControl(AControl);
  {$ENDIF COMPILER11}
  {$ENDIF COMPILER12_UP}
end;

function ControlInGlassPaint(AControl: TControl): Boolean;
{$IFDEF COMPILER11_UP}
var
  Parent: TWinControl;
{$ENDIF COMPILER11_UP}
begin
  {$IFDEF COMPILER11_UP}
  Result := GetGlassPaintFlag(AControl);
  if Result then
  begin
    Parent := AControl.Parent;
    while (Parent <> nil) and not Parent.DoubleBuffered and not (Parent is TCustomForm) do
      Parent := Parent.Parent;
    Result := (Parent = nil) or not Parent.DoubleBuffered or (Parent is TCustomForm);
  end;
  {$ELSE}
  Result := False;
  {$ENDIF COMPILER11_UP}
end;

procedure DrawGlassableText(DC: HDC; const Text: string; var TextRect: TRect; TextFlags: Cardinal;
  PaintOnGlass: Boolean = False);
{$IFDEF COMPILER11_UP}
var
  Options: TDTTOpts;
  {$IFDEF COMPILER11}
  S: WideString;
  {$ENDIF COMPILER11}
{$ENDIF COMPILER11_UP}
begin
  {$IFDEF COMPILER11_UP}
  if StyleServices.Enabled and JclCheckWinVersion(6, 0) then
  begin
    FillChar(Options, SizeOf(Options), 0);
    Options.dwSize := SizeOf(Options);
    if TextFlags and DT_CALCRECT <> 0 then
      Options.dwFlags := Options.dwFlags or DTT_CALCRECT;
    if PaintOnGlass then
      Options.dwFlags := Options.dwFlags or DTT_COMPOSITED;
    Options.dwFlags := Options.dwFlags or DTT_TEXTCOLOR;
    Options.crText := GetTextColor(DC);

    {$IFDEF COMPILER16_UP}
    if not StyleServices.IsSystemStyle then
    begin
      // The Style engine doesn't have DrawThemeTextEx support
      {$WARNINGS OFF} // ignore "deprecated" warning
      StyleServices.DrawText(DC, StyleServices.GetElementDetails(tbPushButtonNormal), Text, TextRect, TextFlags, 0);
      {$WARNINGS ON}
      Exit;
    end
    else
    {$ENDIF}
    begin
      {$IFDEF COMPILER12_UP}
      with ThemeServices do
        if DrawThemeTextEx(Theme[teToolBar], DC, TP_BUTTON, TS_NORMAL, PWideChar(Text), Length(Text),
                           TextFlags, TextRect, Options) <> E_NOTIMPL then
          Exit;
      {$ELSE}
      S := Text;
      with ThemeServices do
        if DrawThemeTextEx(Theme[teToolBar], DC, TP_BUTTON, TS_NORMAL, PWideChar(S), Length(S),
                           TextFlags, @TextRect, Options) <> E_NOTIMPL then
          Exit;
      {$ENDIF COMPILER12_UP}
    end;
  end;
  {$ENDIF COMPILER11_UP}
  Windows.DrawText(DC, PChar(Text), Length(Text), TextRect, TextFlags);
end;

procedure DrawGlassableImageList(ImageList: HIMAGELIST; Index: Integer; Dest: HDC; X, Y: Integer;
  Style: UINT; PaintOnGlass: Boolean = False);
{$IFDEF COMPILER11_UP}
var
  PaintBuffer: HPAINTBUFFER;
  R: TRect;
  MemDC, MaskDC: HDC;
  CX, CY, XX, YY: Integer;
  MaskBmp: TBitmap;
{$ENDIF COMPILER11_UP}
begin
  {$IFDEF COMPILER11_UP}
  if PaintOnGlass and JclCheckWinVersion(6, 0) then
  begin
    { TODO : Not working correctly on a JvSpeedButton. But it works if used direcly on
             a sheet of glass. Some optimizations could be done. }

    ImageList_GetIconSize(ImageList, CX, CY);
    R := Rect(X, Y, X + CX, Y + CY);

    PaintBuffer := BeginBufferedPaint(Dest, R, BPBF_TOPDOWNDIB, nil, MemDC);
    try
      ImageList_Draw(ImageList, Index, MemDC, X, Y, Style);
      BufferedPaintMakeOpaque(PaintBuffer, @R);

      MaskBmp := TBitmap.Create;
      try
        MaskBmp.Width := CX;
        MaskBmp.Height := CY;
        MaskDC := MaskBmp.Canvas.Handle;
        ImageList_Draw(ImageList, Index, MaskDC, 0, 0, ILD_MASK);
        for YY := 0 to CY - 1 do
          for XX := 0 to CX - 1 do
            if GetPixel(MaskDC, XX, YY) <> 0 then
            begin
              R := Rect(X + XX, Y + YY, X + XX + 1, Y + YY + 1);
              BufferedPaintSetAlpha(PaintBuffer, @R, 0);
              //SetPixel(MemDC, X + XX, Y + YY, GetPixel(MemDC, X + XX, Y + YY) and $00FFFFFF);
            end;
      finally
        MaskBmp.Free;
      end;
    finally
      EndBufferedPaint(PaintBuffer, True);
    end;
  end
  else
  {$ENDIF COMPILER11_UP}
    ImageList_Draw(ImageList, Index, Dest, X, Y, Style);
end;
*******************)

(************************ NOT CONVERTED ***
{$IFDEF JVCLThemesEnabled}

{$IFNDEF COMPILER7_UP}
procedure TThemeServicesEx.ApplyThemeChange;
begin
  StyleServices.UpdateThemes;
  StyleServices.DoOnThemeChange;
end;
{$ENDIF ~COMPILER7_UP}

{$IFNDEF COMPILER16_UP}
function TThemeServicesEx.GetElementContentRect(DC: HDC; Details: TThemedElementDetails;
  const BoundingRect: TRect; out AContentRect: TRect): Boolean;
begin
  AContentRect := ContentRect(DC, Details, BoundingRect);
  Result := True;
end;

function TThemeServicesEx.DoGetElementSize(DC: HDC; Details: TThemedElementDetails; Rect: PRect;
  ElementSize: TElementSize; out Size: TSize): Boolean;
const
  ElementSizes: array[TElementSize] of TThemeSize = (TS_MIN, TS_TRUE, TS_DRAW);
begin
  Result := GetThemePartSize(Theme[Details.Element], DC, Details.Part, Details.State, Rect,
    ElementSizes[ElementSize], Size) = S_OK;
end;

function TThemeServicesEx.GetElementSize(DC: HDC; Details: TThemedElementDetails; ElementSize: TElementSize;
  out Size: TSize): Boolean;
begin
  Result := DoGetElementSize(DC, Details, nil, ElementSize, Size);
end;

function TThemeServicesEx.GetElementSize(DC: HDC; Details: TThemedElementDetails; const Rect: TRect;
  ElementSize: TElementSize; out Size: TSize): Boolean;
begin
  Result := DoGetElementSize(DC, Details, @Rect, ElementSize, Size);
end;

function TThemeServicesEx.GetSystemColor(Color: TColor): TColor;
begin
  Result := Color;
end;
**********************)

function TThemeServicesEx.IsSystemStyle: Boolean;
begin
  Result := True;
end;

function TThemeServicesEx.Enabled: Boolean;
begin
  Result := ThemesEnabled;
end;

function TThemeServicesEx.Available: Boolean;
begin
  Result := ThemesAvailable;
end;

(******************************
{$ENDIF ~COMPILER16_UP}
*******************)

function ThemeServices: TThemeServicesEx;
begin
  Result := TThemeServicesEx(
    {$IFDEF COMPILER7_UP}Themes{$ELSE}ThemeSrv{$ENDIF}.{$IFDEF RTL230_UP}StyleServices{$ELSE}ThemeServices{$ENDIF RTL230_UP});
end;

function StyleServices: TThemeServicesEx;
begin
  Result := TThemeServicesEx(
    {$IFDEF COMPILER7_UP}Themes{$ELSE}ThemeSrv{$ENDIF}.{$IFDEF RTL230_UP}StyleServices{$ELSE}ThemeServices{$ENDIF RTL230_UP});
end;

(************************ NOT CONVERTED ***
procedure PaintControlBorder(Control: TWinControl);
begin
  StyleServices.PaintBorder(Control, False)
end;

procedure DrawThemedBorder(Control: TControl);
var
  Details: TThemedElementDetails;
  DrawRect: TRect;
  DC: HDC;
  Handle: THandle;
begin
  if Control is TWinControl then
  begin
    Handle := TWinControl(Control).Handle;
    DC := GetWindowDC(Handle);
    GetWindowRect(Handle, DrawRect);
    OffsetRect(DrawRect, -DrawRect.Left, -DrawRect.Top);
  end
  else
  begin
    if Control.Parent = nil then
      Exit;
    Handle := Control.Parent.Handle;
    DC := GetDC(Handle);
    DrawRect := Control.BoundsRect;
  end;

  ExcludeClipRect(DC, DrawRect.Left + 2, DrawRect.Top + 2, DrawRect.Right - 2, DrawRect.Bottom - 2);
  Details := StyleServices.GetElementDetails(teEditTextNormal);
  StyleServices.DrawElement(DC, Details, DrawRect);

  ReleaseDC(Handle, DC);
end;
***************************)

type
  TControlAccessProtected = class(TControl);

procedure IncludeThemeStyle(Control: TControl; Style: TJvThemeStyle);
begin
  with TControlAccessProtected(Control) do
    ControlStyle := ControlStyle + (Style * [csNeedsBorderPaint, csParentBackground]);
end;

procedure ExcludeThemeStyle(Control: TControl; Style: TJvThemeStyle);
begin
  with TControlAccessProtected(Control) do
    ControlStyle := ControlStyle - (Style * [csNeedsBorderPaint, csParentBackground]);
end;

function GetThemeStyle(Control: TControl): TJvThemeStyle;
begin
  with TControlAccessProtected(Control) do
    Result := ControlStyle * [csNeedsBorderPaint, csParentBackground];
end;

(********************* NOT CONVERTED ***
{$IFDEF JVCLThemesEnabled}

{$IFNDEF COMPILER10_UP}
type
  PPointer = ^Pointer;

var
  OrgWinControlWMPrintClient: procedure(Instance: TObject; var Msg: TMessage);

procedure FixedWMPrintClient(Instance: TObject; var Msg: TMessage);
var
  IdSave: Integer;
begin
  if Msg.Msg = WM_PRINTCLIENT then
  begin
    IdSave := SaveDC(HDC(Msg.WParam));
    try
      OrgWinControlWMPrintClient(Instance, Msg);
    finally
      RestoreDC(HDC(Msg.WParam), IdSave);
    end;
  end
  else
    OrgWinControlWMPrintClient(Instance, Msg);
end;

function FindWMPrintClient: PPointer;
var
  IdxList: PDynamicIndexList;
  I: Integer;
begin
  IdxList := GetDynamicIndexList(TWinControl);
  for I := 0 to GetDynamicMethodCount(TWinControl) - 1 do
    if IdxList[I] = WM_PRINTCLIENT then
    begin
      Result := @(GetDynamicAddressList(TWinControl)[I]);
      Exit;
    end;
  Result := nil;
end;

procedure InitializeWMPrintClientFix;
var
  NewProc: Pointer;
  Proc: PPointer;
  OldProtect, Dummy: Cardinal;
begin
  Proc := FindWMPrintClient();
  if Proc <> nil then
  begin
    OrgWinControlWMPrintClient := Proc^;
    NewProc := @FixedWMPrintClient;

    if VirtualProtect(Proc, SizeOf(NewProc), PAGE_EXECUTE_READWRITE, OldProtect) then
    try
      Proc^ := NewProc;
    finally
      VirtualProtect(Proc, SizeOf(NewProc), OldProtect, Dummy);
    end;
  end;
end;

procedure FinalizeWMPrintClientFix;
var
  NewProc: Pointer;
  Proc: PPointer;
  OldProtect, Dummy: Cardinal;
begin
  Proc := FindWMPrintClient;
  if Proc <> nil then
  begin
    NewProc := @OrgWinControlWMPrintClient;

    if VirtualProtect(Proc, SizeOf(NewProc), PAGE_EXECUTE_READWRITE, OldProtect) then
    try
      Proc^ := NewProc;
    finally
      VirtualProtect(Proc, SizeOf(NewProc), OldProtect, Dummy);
    end;
  end;
end;
{$ENDIF ~COMPILER10_UP}

{$ENDIF JVCLThemesEnabled}
************)

initialization
  (************** NOT CONVERTED ***
  {$IFDEF JVCLThemesEnabled}
  {$IFNDEF COMPILER10_UP}
  InitializeWMPrintClientFix;
  {$ENDIF ~COMPILER10_UP}
  {$ENDIF JVCLThemesEnabled}
  **********)

finalization
  (*************** NOT CONVERTED ***
  {$IFDEF JVCLThemesEnabled}
  {$IFNDEF COMPILER10_UP}
  FinalizeWMPrintClientFix;
  {$ENDIF ~COMPILER10_UP}
  {$ENDIF JVCLThemesEnabled}
  *************)

end.