{-----------------------------------------------------------------------------
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: JvCaptionButton.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net]
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.

This unit is a merging of the original TJvCaptionButton, TJvaCaptionButton.
Merging done 2003-06-12 by Remko Bonte [remkobonte at myrealbox dot com]

All Rights Reserved.

Contributor(s):
  Andrei Prygounkov <a dot prygounkov at gmx dot de>, author of TJvaCaptionButton.
  Remko Bonte [remkobonte at myrealbox dot com], theme support, actions
  Olivier Sannier [obones att altern dott org], caption hints.

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

Modified 2003-06-13 (p3):
- Fixed MouseUp X,Y inconsistentcy (did not report the same values as MouseDown)
- Added MouseMove handler
- Added ShowHint, ParentShowHint
- Fixed drawing of disabled MinimizeToTray icon as well as incorrect Font.Color in text drawing
- Added Assign
- Tested on W2k
- Demo (examples\CaptionBtn) updated and extended

Known Issues:

  * Msimg32.dll code should be moved to seperate import unit. Code is partly
    copied from JwaWinGDI.pas.
  * Button can disappear at design-time when switching themes.
  * With more buttons, button can appear hot while mouse is over another caption
    button.
  * Still some flicker while resizing due to wrong FButtonRect, see comment
    at HandleNCPaintBefore.
  * Buttons on small caption (BorderStyle in [bsSizeToolWin, bsToolWin]) looks
    ugly.

-----------------------------------------------------------------------------}
// $Id: JvCaptionButton.pas 11240 2007-03-28 21:21:47Z remkobonte $

unit JvCaptionButton;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Graphics, Controls, Forms,
  {$IFDEF HAS_UNIT_TYPES}
  Types,
  {$ENDIF HAS_UNIT_TYPES}
  ActnList, ImgList,
  JvComponentBase, JvTypes, JvWin32;

type
  TJvStandardButton = (tsbNone, tsbClose, tsbHelp, tsbMax, tsbMin, tsbRestore,
    tsbMinimizeToTray); // a la e-Mule
  TJvCaptionButtonLayout = (cbImageLeft, cbImageRight);
  TJvRedrawKind = (rkDirect, rkIndirect, rkTotalCaptionBar);

  TJvCaptionButton = class;

  TJvCaptionButtonActionLink = class(TActionLink)
  protected
    FClient: TJvCaptionButton;
    procedure AssignClient(AClient: TObject); override;
    function IsCaptionLinked: Boolean; override;
    function IsEnabledLinked: Boolean; override;
    function IsHintLinked: Boolean; override;
    function IsImageIndexLinked: Boolean; override;
    function IsVisibleLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;

    procedure SetCaption(const Value: string); override;
    procedure SetEnabled(Value: Boolean); override;
    procedure SetHint(const Value: string); override;
    procedure SetImageIndex(Value: Integer); override;
    procedure SetVisible(Value: Boolean); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
  end;

  TJvCaptionButtonActionLinkClass = class of TJvCaptionButtonActionLink;

  TJvCaptionButton = class(TJvComponent)
  private
    { Properties }
    FAlignment: TAlignment;
    FHeight: Integer;
    FLeft: Integer;
    FTop: Integer;
    FWidth: Integer;
    FCaption: string;
    FDown: Boolean;
    FEnabled: Boolean;
    FFont: TFont;
    FHint: string;
    FImageIndex: TImageIndex;
    FImages: TCustomImageList;
    FLayout: TJvCaptionButtonLayout;
    FMargin: Integer;
    FPosition: Integer;
    FSpacing: Integer;
    FStandard: TJvStandardButton;
    FToggle: Boolean;
    FVisible: Boolean;
    FOnClick: TNotifyEvent;
    FOnMouseUp: TMouseEvent;
    FOnMouseDown: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;

    FDefaultButtonLeft: Integer;
    FDefaultButtonTop: Integer;
    FDefaultButtonWidth: Integer;
    FDefaultButtonHeight: Integer;

    FActionLink: TJvCaptionButtonActionLink;
    FBuffer: TBitmap;
    FButtonRect: TRect;
    FCaptionHeight: Integer;
    FClickRect: TRect; // Clickable area is a bit bigger than the button
    FHasCaption: Boolean; // True, if the form has a caption
    FHasSmallCaption: Boolean; // True, if the form has BorderStyle bsToolWindow, bsSizeToolWin
    FImageChangeLink: TChangeLink;
    FMouseButtonDown: Boolean;
    FMouseInControl: Boolean;
    FNeedRecalculate: Boolean;
    FRgnChanged: Boolean;
    FSaveRgn: HRGN;
    FShowHint: Boolean;
    FParentShowHint: Boolean;

    {tool tip specific}
    FToolTipHandle: THandle;
    {tool tip specific end}

    {$IFDEF JVCLThemesEnabled}
    FCaptionActive: Boolean;
    FForceDrawSimple: Boolean;
    function GetIsThemed: Boolean;
    procedure SetForceDrawSimple(const Value: Boolean);
    {$ENDIF JVCLThemesEnabled}
    function GetAction: TBasicAction;
    function GetIsImageVisible: Boolean;
    function GetParentForm: TCustomForm;
    function GetParentFormHandle: THandle;
    function IsCaptionStored: Boolean;
    function IsEnabledStored: Boolean;
    function IsHintStored: Boolean;
    function IsImageIndexStored: Boolean;
    procedure SetAction(const Value: TBasicAction);
    procedure SetAlignment(Value: TAlignment);
    procedure SetCaption(Value: string);
    procedure SetDown(const Value: Boolean);
    procedure SetEnabled(const Value: Boolean);
    procedure SetFont(Value: TFont);
    procedure SetHeight(Value: Integer);
    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetLayout(const Value: TJvCaptionButtonLayout);
    procedure SetLeft(Value: Integer);
    procedure SetMargin(const Value: Integer);
    procedure SetMouseInControl(const Value: Boolean);
    procedure SetPosition(const Value: Integer);
    procedure SetSpacing(const Value: Integer);
    procedure SetStandard(Value: TJvStandardButton);
    procedure SetToggle(const Value: Boolean);
    procedure SetTop(Value: Integer);
    procedure SetVisible(const Value: Boolean);
    procedure SetWidth(Value: Integer);

    {tool tip handling}
    procedure CreateToolTip(Wnd: THandle);
    procedure DestroyToolTip;
    procedure HideToolTip;
    procedure ForwardToToolTip(Msg: TMessage);

    procedure Hook;
    procedure UnHook;
    function WndProcAfter(var Msg: TMessage): Boolean;
    function WndProcBefore(var Msg: TMessage): Boolean;

    procedure DrawButton(DC: HDC);
    {$IFDEF JVCLThemesEnabled}
    procedure DrawButtonBackground(ACanvas: TCanvas);
    {$ENDIF JVCLThemesEnabled}
    procedure DrawStandardButton(ACanvas: TCanvas);
    procedure DrawNonStandardButton(ACanvas: TCanvas);
    procedure DrawButtonImage(ACanvas: TCanvas; ImageBounds: TRect);
    procedure DrawButtonText(ACanvas: TCanvas; TextBounds: TRect);

    procedure Redraw(const AKind: TJvRedrawKind);
    procedure CalcDefaultButtonRect(Wnd: THandle);

    {Paint related messages}
    procedure HandleNCActivate(var Msg: TWMNCActivate);
    procedure HandleNCPaintAfter(Wnd: THandle; var Msg: TWMNCPaint);
    procedure HandleNCPaintBefore(Wnd: THandle; var Msg: TWMNCPaint);
    {Mouse down-related messages}
    function HandleButtonDown(var Msg: TWMNCHitMessage): Boolean;
    function HandleButtonUp(var Msg: TWMNCHitMessage): Boolean;
    function HandleHitTest(var Msg: TWMNCHitTest): Boolean;
    function HandleMouseMove(var Msg: TWMNCHitMessage): Boolean;
    procedure HandleNCMouseMove(var Msg: TWMNCHitMessage);
    {Other}
    function HandleNotify(var Msg: TWMNotify): Boolean;

    procedure ImageListChange(Sender: TObject);
    procedure DoActionChange(Sender: TObject);

    function MouseOnButton(X, Y: Integer; const TranslateToScreenCoord: Boolean): Boolean;
    procedure SetParentShowHint(const Value: Boolean);
    procedure SetShowHint(const Value: Boolean);
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
    procedure CalcButtonParts(ACanvas: TCanvas; ButtonRect: TRect; var RectText, RectImage: TRect);
    function GetActionLinkClass: TJvCaptionButtonActionLinkClass; dynamic;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure UpdateButtonRect(Wnd: THandle);

    property ActionLink: TJvCaptionButtonActionLink read FActionLink write FActionLink;
    property IsImageVisible: Boolean read GetIsImageVisible;
    {$IFDEF JVCLThemesEnabled}
    // The value of IsThemed stays the same until a WM_THEMECHANGED is received.
    property IsThemed: Boolean read GetIsThemed;
    {$ENDIF JVCLThemesEnabled}
    property MouseInControl: Boolean read FMouseInControl;
    property ParentFormHandle: THandle read GetParentFormHandle;
    property ParentForm: TCustomForm read GetParentForm;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure InitiateAction; virtual;
    procedure ResetButton;
    procedure Click; dynamic;
    
    property DefaultButtonWidth: Integer read FDefaultButtonWidth;
  published
    property Action: TBasicAction read GetAction write SetAction;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property ButtonHeight: Integer read FHeight write SetHeight default 0;
    property ButtonLeft: Integer read FLeft write SetLeft default 0;
    property ButtonTop: Integer read FTop write SetTop default 0;
    property ButtonWidth: Integer read FWidth write SetWidth default 0;
    property Caption: string read FCaption write SetCaption stored IsCaptionStored;
    property Down: Boolean read FDown write SetDown default False;
    {$IFDEF JVCLThemesEnabled}
    property ForceDrawSimple: Boolean read FForceDrawSimple write SetForceDrawSimple default False;
    {$ENDIF JVCLThemesEnabled}
    property ShowHint: Boolean read FShowHint write SetShowHint default False;
    property ParentShowHint: Boolean read FParentShowHint write SetParentShowHint default True;
    property Enabled: Boolean read FEnabled write SetEnabled stored IsEnabledStored default True;
    property Font: TFont read FFont write SetFont;
    property Hint: string read FHint write FHint stored IsHintStored;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored default -1;
    property Images: TCustomImageList read FImages write SetImages;
    property Layout: TJvCaptionButtonLayout read FLayout write SetLayout default cbImageLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property Position: Integer read FPosition write SetPosition default 0;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Standard: TJvStandardButton read FStandard write SetStandard default tsbNone;
    property Toggle: Boolean read FToggle write SetToggle default False;
    property Visible: Boolean read FVisible write SetVisible default True;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  end;

function TransparentBlt(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, hHeightDest: Integer;
  hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer;
  crTransparent: UINT): BOOL; stdcall;
function AlphaBlend(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest,
  nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc,
  nHeightSrc: Integer; BlendFunction: BLENDFUNCTION): BOOL; stdcall;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvCaptionButton.pas $';
    Revision: '$Revision: 11240 $';
    Date: '$Date: 2007-03-28 23:21:47 +0200 (mer., 28 mars 2007) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  CommCtrl, Buttons, SysUtils,
  JvThemes,
  {$IFDEF JVCLThemesEnabled}
  UxTheme,
  {$IFNDEF COMPILER7_UP}
  TmSchema,
  {$ENDIF !COMPILER7_UP}
  JvJVCLUtils,
  {$ENDIF JVCLThemesEnabled}
  JvDsgnIntf, JvConsts, JvJCLUtils, JvResources, JvWndProcHook;

const
  { Msimg32.dll is included in Windows 98 and later }
  Msimg32DLLName = 'Msimg32.dll';

  TransparentBltName = 'TransparentBlt';
  AlphaBlendName = 'AlphaBlend';

  htCaptionButton = HTSIZELAST + 1;
  Alignments: array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);

var
  GMsimg32Handle: THandle = 0;
  GTriedLoadMsimg32Dll: Boolean = False;

  _AlphaBlend: Pointer;
  _TransparentBlt: Pointer;

{$IFDEF JVCLThemesEnabled}

type
  { (rb) I couldn't get the alpha channel to work with the normal TBitmap so
         introduced TAlphaBitmap. TBitmapAdapter hides the implementation details
         of the TBitmap/TAlphaBitmap }

  TAlphaBitmap = class(TObject)
  private
    FHandle: HDC;
    FBitmapInfo: TBitmapInfo;
    FDIBHandle: HBitmap;
    FOldBitmap: HBitmap;
    FBitsMem: Pointer;
    FBitCount: Byte;
    FHasAlphaChannel: Boolean;
    function GetWidth: Integer;
    function GetHeight: Integer;
  protected
    procedure CreateHandle(AWidth, AHeight: Integer);
    function CreateDIB(ADC: HDC; AWidth, AHeight: Integer): HBitmap;
    procedure Duplicate(Src: HBitmap);
    procedure FreeHandle;
    procedure InitAlpha;
  public
    destructor Destroy; override;
    procedure Assign(Source: TPersistent);

    procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
    procedure LoadFromResourceName(Instance: THandle; const ResName: string);

    property Handle: HDC read FHandle;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    property Data: Pointer read FBitsMem;
    property BitCount: Byte read FBitCount;
    property HasAlphaChannel: Boolean read FHasAlphaChannel;
  end;

  TBitmapAdapter = class(TObject)
  private
    FBitmap: TObject;
    FMargins: TMargins;
    FTransparentColor: TColorRef;
    function GetHeight: Integer;
    function GetWidth: Integer;
    function GetIsValid: Boolean;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Clear;
    procedure Assign(Source: TPersistent);

    procedure LoadFromResourceName(Instance: THandle; const ResName: string);
    procedure LoadFromResourceID(Instance: THandle; ResID: Integer);

    function Draw(ACanvas: TCanvas; const Rect: TRect; AMargins: PMargins): Boolean;
    function DrawFixed(ACanvas: TCanvas; const X, Y: Integer): Boolean;
    function DrawFixedPart(ACanvas: TCanvas; const DestRect: TRect; const SrcX, SrcY: Integer): Boolean;
    function DrawPart(ACanvas: TCanvas; const SrcRect, DestRect: TRect; AMargins: PMargins): Boolean;

    property Margins: TMargins read FMargins write FMargins;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    property IsValid: Boolean read GetIsValid;
    property TransparentColor: TColorRef read FTransparentColor write FTransparentColor;
  end;

  TGlobalXPData = class(TObject)
  private
    FCaptionButtonHeight: Integer;
    FCaptionButtonCount: Integer;
    FCaptionButtons: TBitmapAdapter;

    FIsThemed: Boolean;
    FBitmapValid: Boolean;
    FClientCount: Integer;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure AddClient;
    procedure RemoveClient;

    procedure Update;
    procedure DrawSimple(ACanvas: TCanvas; State: Integer; const DrawRect: TRect);
    function Draw(ACanvas: TCanvas; State: Integer; const DrawRect: TRect): Boolean;
    property IsThemed: Boolean read FIsThemed;
  end;

var
  GGlobalXPData: TGlobalXPData;

//=== Local procedures =======================================================

function GlobalXPData: TGlobalXPData;
begin
  if not Assigned(GGlobalXPData) then
    GGlobalXPData := TGlobalXPData.Create;

  Result := GGlobalXPData;
end;

function TranslateBitmapFileName(const S: string): string;
var
  I: Integer;
begin
  Result := S;
  for I := 1 to Length(S) do
    case S[I] of
      'A'..'Z', '0'..'9':
        {do nothing};
      'a'..'z':
        Result[I] := UpCase(S[I]);
    else
      Result[I] := '_';
    end;
end;

procedure DupBits(Src, Dst: HBitmap; Size: TPoint);
var
  MemDC: HDC;
  DesktopDC: HDC;
  OldBitmap: HBitmap;
begin
  OldBitmap := 0;
  DesktopDC := GetDC(GetDesktopWindow);
  MemDC := CreateCompatibleDC(DesktopDC);
  try
    OldBitmap := SelectObject(MemDC, Src);
    BitBlt(Dst, 0, 0, Size.X, Size.Y, MemDC, 0, 0, SRCCOPY);
  finally
    SelectObject(MemDC, OldBitmap);
    ReleaseDC(GetDesktopWindow, DesktopDC);
    DeleteDC(MemDC);
  end;
end;

function GetHasAlphaChannel(Data: PChar; Count: Integer): Boolean;
begin
  Result := False;

  while Count > 0 do
  begin
    Result := PRGBQuad(Data).rgbReserved <> 0;
    if Result then
      Exit;
    Inc(Data, 4);
    Dec(Count);
  end;
end;

procedure PreMultiplyAlphaChannel(Data: PChar; Count: Integer);
begin
  while Count > 0 do
  begin
    with PRGBQuad(Data)^ do
    begin
      rgbBlue := (rgbBlue * rgbReserved + 128) div 255;
      rgbGreen := (rgbGreen * rgbReserved + 128) div 255;
      rgbRed := (rgbRed * rgbReserved + 128) div 255;
    end;
    Inc(Data, 4);
    Dec(Count);
  end;
end;

{$ENDIF JVCLThemesEnabled}

procedure UnloadMsimg32Dll;
begin
  _TransparentBlt := nil;
  _AlphaBlend := nil;
  if GMsimg32Handle > 0 then
    FreeLibrary(GMsimg32Handle);
  GMsimg32Handle := 0;
end;

procedure LoadMsimg32Dll;
begin
  GTriedLoadMsimg32Dll := True;
  GMsimg32Handle := Windows.LoadLibrary(Msimg32DLLName);
  if GMsimg32Handle > 0 then
  begin
    _TransparentBlt := GetProcAddress(GMsimg32Handle, TransparentBltName);
    _AlphaBlend := GetProcAddress(GMsimg32Handle, AlphaBlendName);
  end;
end;

{$IFDEF JVCLThemesEnabled}

function TransparentBltStretch(DestDC: HDC; const DestRect: TRect;
  SourceDC: HDC; const SourceRect: TRect; const SizingMargins: TMargins;
  const TransparentColor: TColor): Boolean;
var
  ESourceWidth, ESourceHeight: Integer;
  EDestWidth, EDestHeight: Integer;
  LastOriginSource: TPoint;
  LastOriginDest: TPoint;
begin
  {                Source                           Dest

               |--------------|             |--------------------|
               | A |   B  | C |             | A |      B     | C |
               |-- |------|---|             |-- |------------|---|
               |   |      |   |             |   |            |   |
               | D |   E  | F |             |   |            |   |
               |   |      |   |     =>      | D |      E     | F |
               |---|------|---|             |   |            |   |
               | G |   H  | I |             |   |            |   |
               |--------------|             |--------------------|
                                            | G |      H     | I |
                                            |-- |------------|---|
  }
  ESourceWidth := SourceRect.Right - SourceRect.Left - SizingMargins.cxLeftWidth - SizingMargins.cxRightWidth;
  ESourceHeight := SourceRect.Bottom - SourceRect.Top - SizingMargins.cyTopHeight - SizingMargins.cyBottomHeight;
  EDestWidth := DestRect.Right - DestRect.Left - SizingMargins.cxLeftWidth - SizingMargins.cxRightWidth;
  EDestHeight := DestRect.Bottom - DestRect.Top - SizingMargins.cyTopHeight - SizingMargins.cyBottomHeight;

  GetWindowOrgEx(SourceDC, LastOriginSource);
  SetWindowOrgEx(SourceDC, LastOriginSource.X - SourceRect.Left, LastOriginSource.Y - SourceRect.Top, nil);
  GetWindowOrgEx(DestDC, LastOriginDest);
  SetWindowOrgEx(DestDC, LastOriginDest.X - DestRect.Left, LastOriginDest.Y - DestRect.Top, nil);

  Result :=
    { A }
  TransparentBlt(
    DestDC,
    0, 0, SizingMargins.cxLeftWidth, SizingMargins.cyTopHeight,
    SourceDC,
    0, 0, SizingMargins.cxLeftWidth, SizingMargins.cyTopHeight,
    TransparentColor
    ) and

  { B }
  TransparentBlt(
    DestDC,
    SizingMargins.cxLeftWidth, 0, EDestWidth, SizingMargins.cyTopHeight,
    SourceDC,
    SizingMargins.cxLeftWidth, 0, ESourceWidth, SizingMargins.cyTopHeight,
    TransparentColor
    ) and

  { C }
  TransparentBlt(
    DestDC,
    EDestWidth + SizingMargins.cxLeftWidth, 0, SizingMargins.cxRightWidth, SizingMargins.cyTopHeight,
    SourceDC,
    ESourceWidth + SizingMargins.cxLeftWidth, 0, SizingMargins.cxRightWidth, SizingMargins.cyTopHeight,
    TransparentColor
    ) and

  { D }
  TransparentBlt(
    DestDC,
    0, SizingMargins.cyTopHeight, SizingMargins.cxLeftWidth, EDestHeight,
    SourceDC,
    0, SizingMargins.cyTopHeight, SizingMargins.cxLeftWidth, ESourceHeight,
    TransparentColor
    ) and

  { E }
  TransparentBlt(
    DestDC,
    SizingMargins.cxLeftWidth, SizingMargins.cyTopHeight, EDestWidth, EDestHeight,
    SourceDC,
    SizingMargins.cxLeftWidth, SizingMargins.cyTopHeight, ESourceWidth, ESourceHeight,
    TransparentColor
    ) and

  { F }
  TransparentBlt(
    DestDC,
    EDestWidth + SizingMargins.cxLeftWidth, SizingMargins.cyTopHeight, SizingMargins.cxRightWidth, EDestHeight,
    SourceDC,
    ESourceWidth + SizingMargins.cxLeftWidth, SizingMargins.cyTopHeight, SizingMargins.cxRightWidth, ESourceHeight,
    TransparentColor
    ) and

  { G }
  TransparentBlt(
    DestDC,
    0, EDestHeight + SizingMargins.cyTopHeight, SizingMargins.cxLeftWidth, SizingMargins.cyBottomHeight,
    SourceDC,
    0, ESourceHeight + SizingMargins.cyTopHeight, SizingMargins.cxLeftWidth, SizingMargins.cyBottomHeight,
    TransparentColor
    ) and

  { H }
  TransparentBlt(
    DestDC,
    SizingMargins.cxLeftWidth, EDestHeight + SizingMargins.cyTopHeight, EDestWidth, SizingMargins.cyBottomHeight,
    SourceDC,
    SizingMargins.cxLeftWidth, ESourceHeight + SizingMargins.cyTopHeight, ESourceWidth, SizingMargins.cyBottomHeight,
    TransparentColor
    ) and

  { I }
  TransparentBlt(
    DestDC,
    EDestWidth + SizingMargins.cxLeftWidth, EDestHeight + SizingMargins.cyTopHeight,
    SizingMargins.cxRightWidth, SizingMargins.cyBottomHeight,
    SourceDC,
    ESourceWidth + SizingMargins.cxLeftWidth, ESourceHeight + SizingMargins.cyTopHeight,
    SizingMargins.cxRightWidth, SizingMargins.cyBottomHeight,
    TransparentColor
    );

  SetWindowOrgEx(SourceDC, LastOriginSource.X, LastOriginSource.Y, nil);
  SetWindowOrgEx(DestDC, LastOriginDest.X, LastOriginDest.Y, nil);
end;

function GetXPCaptionButtonBitmap(ABitmap: TBitmapAdapter; out BitmapCount: Integer): Boolean;
var
  Handle: THandle;
  ThemeFileNameW, BitmapFileNameW: array [0..MAX_PATH] of WideChar;
  OldError: Longint;
  Details: TThemedElementDetails;
  Margins: TMargins;
begin
  ThemeFileNameW[MAX_PATH] := #0;
  BitmapFileNameW[MAX_PATH] := #0;

  Result := UxTheme.GetCurrentThemeName(ThemeFileNameW, MAX_PATH, nil, 0, nil, 0) = S_OK;
  if not Result then
    Exit;

  Details := ThemeServices.GetElementDetails(twMinButtonNormal);
  with Details do
    Result := GetThemeFilename(ThemeServices.Theme[Element], Part, State,
      TMT_IMAGEFILE, BitmapFileNameW, MAX_PATH) = S_OK;
  if not Result then
    Exit;

  with Details do
    Result := GetThemeInt(ThemeServices.Theme[Element], Part, State,
      TMT_IMAGECOUNT, BitmapCount) = S_OK;
  if not Result then
    Exit;

  Result := BitmapCount > 0;
  if not Result then
    Exit;

  with Details do
    if GetThemeMargins(ThemeServices.Theme[Element], 0, Part, State,
      TMT_SIZINGMARGINS, nil, Margins) <> S_OK then
      FillChar(Margins, SizeOf(Margins), 0);
  ABitmap.Margins := Margins;

  OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS);
  try
    Handle := LoadLibraryW(ThemeFileNameW);
    if Handle > 0 then
    try
      ABitmap.Assign(nil); // fixes GDI resource leak
      ABitmap.LoadFromResourceName(Handle, TranslateBitmapFileName(BitmapFileNameW));
      { (rb) can't determine actual transparent color? }
      ABitmap.TransparentColor := clFuchsia;

      Result := (ABitmap.Width > 0) and (ABitmap.Height > 0);
    finally
      FreeLibrary(Handle);
    end;
  finally
    SetErrorMode(OldError);
  end;
end;

{$ENDIF JVCLThemesEnabled}

//=== Global procedures ======================================================

function AlphaBlend;
begin
  if not GTriedLoadMsimg32Dll then
    LoadMsimg32Dll;
  Result := Assigned(_AlphaBlend);
  if Result then
    asm
      mov esp, ebp
      pop ebp
      jmp [_AlphaBlend]
    end;
end;

function TransparentBlt;
begin
  if not GTriedLoadMsimg32Dll then
    LoadMsimg32Dll;
  Result := Assigned(_TransparentBlt);
  if Result then
    asm
      mov esp, ebp
      pop ebp
      jmp [_TransparentBlt]
    end;
end;

{$IFDEF JVCLThemesEnabled}

//=== { TAlphaBitmap } =======================================================

destructor TAlphaBitmap.Destroy;
begin
  FreeHandle;
  inherited Destroy;
end;

procedure TAlphaBitmap.Assign(Source: TPersistent);
begin
  // What to do here when Source is not nil???
  if not Assigned(Source) then
    FreeHandle
  else
    ;
end;

function TAlphaBitmap.CreateDIB(ADC: HDC; AWidth, AHeight: Integer): HBitmap;
begin
  with FBitmapInfo.bmiHeader do
  begin
    biSize := SizeOf(FBitmapInfo.bmiHeader);
    biWidth := AWidth;
    biHeight := AHeight;
    biPlanes := 1;
    biBitCount := 32;
    biCompression := BI_RGB;
    biSizeImage := AWidth * AHeight * 4;
  end;
  // Create the DIB
  Result := CreateDIBSection(ADC, FBitmapInfo, DIB_RGB_COLORS, FBitsMem, 0, 0);
end;

procedure TAlphaBitmap.CreateHandle(AWidth, AHeight: Integer);
var
  H: HBitmap;
begin
  FreeHandle;

  H := CreateScreenCompatibleDC;
  FDIBHandle := CreateDIB(H, AWidth, AHeight);
  if FDIBHandle <> 0 then
    FOldBitmap := SelectObject(H, FDIBHandle)
  else
    FOldBitmap := 0;
  FHandle := H;
end;

procedure TAlphaBitmap.Duplicate(Src: HBitmap);
var
  Bitmap: Windows.TBitmap;
begin
  GetObject(Src, SizeOf(Bitmap), @Bitmap);
  CreateHandle(Bitmap.bmWidth, Bitmap.bmHeight);

  DupBits(Src, FHandle, Point(Bitmap.bmWidth, Bitmap.bmHeight));
end;

procedure TAlphaBitmap.FreeHandle;
begin
  if FHandle <> 0 then
  begin
    if FDIBHandle <> 0 then
    begin
      if FOldBitmap <> 0 then
        SelectObject(FHandle, FOldBitmap);
      DeleteObject(FDIBHandle);
    end;
    DeleteDC(FHandle);
  end;
end;

function TAlphaBitmap.GetHeight: Integer;
begin
  Result := FBitmapInfo.bmiHeader.biHeight;
end;

function TAlphaBitmap.GetWidth: Integer;
begin
  Result := FBitmapInfo.bmiHeader.biWidth;
end;

procedure TAlphaBitmap.InitAlpha;
var
  Count: Integer;
begin
  Count := Width * Height;
  if BitCount < 32 then
    FHasAlphaChannel := False
  else
  begin
    FHasAlphaChannel := GetHasAlphaChannel(Data, Count);

    if HasAlphaChannel then
      PreMultiplyAlphaChannel(Data, Count);
  end;
end;

procedure TAlphaBitmap.LoadFromResourceID(Instance: THandle; ResID: Integer);
var
  Stream: TCustomMemoryStream;
  BitmapInfoHeader: TBitmapInfoHeader;
  BitmapHandle: HBitmap;
begin
  Stream := TResourceStream.CreateFromID(Instance, ResID, RT_BITMAP);
  try
    Stream.Read(BitmapInfoHeader, SizeOf(TBitmapInfoHeader));
    FBitCount := BitmapInfoHeader.biBitCount;
  finally
    Stream.Free;
  end;

  if FBitCount = 32 then
  begin
    BitmapHandle := LoadImage(Instance, PChar(ResID), IMAGE_BITMAP, 0, 0, LR_CREATEDIBSECTION);
    if BitmapHandle = 0 then
      Exit;

    Duplicate(BitmapHandle);
    DeleteObject(BitmapHandle);

    InitAlpha;
  end;
end;

procedure TAlphaBitmap.LoadFromResourceName(Instance: THandle; const ResName: string);
var
  Stream: TCustomMemoryStream;
  BitmapInfoHeader: TBitmapInfoHeader;
  BitmapHandle: HBitmap;
begin
  Stream := TResourceStream.Create(Instance, ResName, RT_BITMAP);
  try
    Stream.Read(BitmapInfoHeader, SizeOf(TBitmapInfoHeader));
    FBitCount := BitmapInfoHeader.biBitCount;
  finally
    Stream.Free;
  end;

  if FBitCount = 32 then
  begin
    BitmapHandle := LoadImage(Instance, PChar(ResName), IMAGE_BITMAP, 0, 0, LR_CREATEDIBSECTION);
    if BitmapHandle = 0 then
      Exit;

    Duplicate(BitmapHandle);
    DeleteObject(BitmapHandle);

    InitAlpha;
  end;
end;

//=== { TBitmapAdapter } =====================================================

constructor TBitmapAdapter.Create;
begin
  inherited Create;
  FTransparentColor := clFuchsia;
end;

destructor TBitmapAdapter.Destroy;
begin
  FBitmap.Free;
  inherited Destroy;
end;

procedure TBitmapAdapter.Assign(Source: TPersistent);
begin
  if FBitmap is TBitmap then
    (FBitmap as TBitmap).Assign(Source)
  else
  if FBitmap is TAlphaBitmap then
    (FBitmap as TAlphaBitmap).Assign(Source);
end;

procedure TBitmapAdapter.Clear;
begin
  FreeAndNil(FBitmap);
end;

function TBitmapAdapter.Draw(ACanvas: TCanvas; const Rect: TRect;
  AMargins: PMargins): Boolean;
begin
  if (Rect.Right - Rect.Left = Width) and (Rect.Bottom - Rect.Top = Height) then
    Result := DrawFixedPart(ACanvas, Rect, 0, 0)
  else
  begin
    if AMargins = nil then
      AMargins := @FMargins;

    if FBitmap is TAlphaBitmap then
      with TAlphaBitmap(FBitmap) do
        Result := TransparentBltStretch(ACanvas.Handle, Rect, Handle,
          Bounds(0, 0, Width, Height), AMargins^, FTransparentColor)
    else
    if FBitmap is TBitmap then
      with TBitmap(FBitmap) do
        Result := TransparentBltStretch(ACanvas.Handle, Rect, Canvas.Handle,
          Bounds(0, 0, Width, Height), AMargins^, FTransparentColor)
    else
      Result := False;
  end;
end;

function TBitmapAdapter.DrawFixed(ACanvas: TCanvas; const X, Y: Integer): Boolean;
begin
  Result := DrawFixedPart(ACanvas, Bounds(X, Y, Width, Height), 0, 0);
end;

function TBitmapAdapter.DrawFixedPart(ACanvas: TCanvas;
  const DestRect: TRect; const SrcX, SrcY: Integer): Boolean;
var
  BlendFunction: TBlendFunction;
  W, H: Integer;
begin
  W := DestRect.Right - DestRect.Left;
  H := DestRect.Bottom - DestRect.Top;

  if FBitmap is TAlphaBitmap then
  begin
    with TAlphaBitmap(FBitmap) do
    begin
      BlendFunction.BlendOp := AC_SRC_OVER;
      BlendFunction.BlendFlags := 0;
      BlendFunction.SourceConstantAlpha := $FF;
      BlendFunction.AlphaFormat := AC_SRC_ALPHA;

      Result := AlphaBlend(ACanvas.Handle, DestRect.Left, DestRect.Top, W, H,
        Handle, SrcX, SrcY, W, H, BlendFunction);
    end;
  end
  else
  if FBitmap is TBitmap then
    with TBitmap(FBitmap) do
      Result := TransparentBlt(ACanvas.Handle, DestRect.Left, DestRect.Top, W, H,
        Canvas.Handle, SrcX, SrcY, W, H, Self.TransparentColor)
  else
    Result := False;
end;

function TBitmapAdapter.DrawPart(ACanvas: TCanvas; const SrcRect,
  DestRect: TRect; AMargins: PMargins): Boolean;
begin
  // Same width/height?
  if (SrcRect.Right - SrcRect.Left = DestRect.Right - DestRect.Left) and
    (SrcRect.Bottom - SrcRect.Top = DestRect.Bottom - DestRect.Top) then
    Result := DrawFixedPart(ACanvas, DestRect, SrcRect.Left, SrcRect.Top)
  else
  begin
    if AMargins = nil then
      AMargins := @FMargins;

    if FBitmap is TAlphaBitmap then
      with TAlphaBitmap(FBitmap) do
        Result := TransparentBltStretch(ACanvas.Handle, DestRect, Handle, SrcRect,
          AMargins^, Self.TransparentColor)
    else
    if FBitmap is TBitmap then
      with TBitmap(FBitmap) do
        Result := TransparentBltStretch(ACanvas.Handle, DestRect, Canvas.Handle, SrcRect,
          AMargins^, Self.TransparentColor)
    else
      Result := False;
  end;
end;

function TBitmapAdapter.GetHeight: Integer;
begin
  if FBitmap is TAlphaBitmap then
    Result := TAlphaBitmap(FBitmap).Height
  else
  if FBitmap is TBitmap then
    Result := TBitmap(FBitmap).Height
  else
    Result := 0;
end;

function TBitmapAdapter.GetIsValid: Boolean;
begin
  Result := Assigned(FBitmap);
end;

function TBitmapAdapter.GetWidth: Integer;
begin
  if FBitmap is TAlphaBitmap then
    Result := TAlphaBitmap(FBitmap).Width
  else
  if FBitmap is TBitmap then
    Result := TBitmap(FBitmap).Width
  else
    Result := 0;
end;

procedure TBitmapAdapter.LoadFromResourceID(Instance: THandle; ResID: Integer);
var
  AlphaBitmap: TAlphaBitmap;
begin
  Clear;

  AlphaBitmap := TAlphaBitmap.Create;
  try
    AlphaBitmap.LoadFromResourceID(Instance, ResID);
    if AlphaBitmap.BitCount < 32 then
    begin
      FBitmap := TBitmap.Create;
      TBitmap(FBitmap).LoadFromResourceID(Instance, ResID);
    end
    else
    begin
      FBitmap := AlphaBitmap;
      AlphaBitmap := nil;
    end;
  finally
    AlphaBitmap.Free;
  end;
end;

procedure TBitmapAdapter.LoadFromResourceName(Instance: THandle; const ResName: string);
var
  AlphaBitmap: TAlphaBitmap;
begin
  Clear;

  AlphaBitmap := TAlphaBitmap.Create;
  try
    AlphaBitmap.LoadFromResourceName(Instance, ResName);
    if AlphaBitmap.BitCount < 32 then
    begin
      FBitmap := TBitmap.Create;
      TBitmap(FBitmap).LoadFromResourceName(Instance, ResName);
    end
    else
    begin
      FBitmap := AlphaBitmap;
      AlphaBitmap := nil;
    end;
  finally
    AlphaBitmap.Free;
  end;
end;

//=== { TGlobalXPData } ======================================================

constructor TGlobalXPData.Create;
begin
  inherited Create;
  Update;
end;

destructor TGlobalXPData.Destroy;
begin
  FCaptionButtons.Free;
  inherited Destroy;
end;

procedure TGlobalXPData.AddClient;
begin
  Inc(FClientCount);
end;

function TGlobalXPData.Draw(ACanvas: TCanvas; State: Integer;
  const DrawRect: TRect): Boolean;
var
  SrcRect: TRect;
begin
  Result := FBitmapValid;
  if not Result then
    Exit;

  { State is 1-based }
  if (State >= FCaptionButtonCount) and (State > 4) then
    State := ((State - 1) mod 4) + 1;
  if State > FCaptionButtonCount then
    State := FCaptionButtonCount;

  SrcRect := Bounds(0, FCaptionButtonHeight * (State - 1),
    FCaptionButtons.Width, FCaptionButtonHeight);

  Result := FCaptionButtons.DrawPart(ACanvas, SrcRect, DrawRect, nil);
end;

procedure TGlobalXPData.DrawSimple(ACanvas: TCanvas; State: Integer;
  const DrawRect: TRect);
const
  // Normal, Hot, Pushed, Disabled,
  cCaptionButton: array [0..3] of TThemedWindow =
    (twMinButtonNormal, twMinButtonHot, twMinButtonPushed, twMinButtonDisabled);
  cNormalButton: array [0..3] of TThemedButton =
    (tbPushButtonNormal, tbPushButtonHot, tbPushButtonPressed, tbPushButtonDisabled);
var
  Details: TThemedElementDetails;
  DrawRgn: HRGN;
begin
  { Draw the button in 2 pieces, draw the edge of a caption button, and the
    inner of a normal button, because drawing a normal button looks ugly }

  // State = 1..8 -> State = 0..3
  State := (State - 1) mod 4;

  { 1a. Draw the outer bit as a caption button }
  Details := ThemeServices.GetElementDetails(cCaptionButton[State]);
  ThemeServices.DrawElement(ACanvas.Handle, Details, DrawRect);

  { 1b. Draw the inner bit as a normal button }
  with DrawRect do
    DrawRgn := CreateRectRgn(Left + 1, Top + 1, Right - 1, Bottom - 1);
  try
    Details := ThemeServices.GetElementDetails(cNormalButton[State]);
    SelectClipRgn(ACanvas.Handle, DrawRgn);
    ThemeServices.DrawElement(ACanvas.Handle, Details, DrawRect);
    SelectClipRgn(ACanvas.Handle, 0);
  finally
    DeleteObject(DrawRgn);
  end;
end;

procedure TGlobalXPData.RemoveClient;
begin
  Dec(FClientCount);
  if FClientCount = 0 then
  begin
    if Self = GGlobalXPData then
      GGlobalXPData := nil;
    Self.Free;
  end;
end;

procedure TGlobalXPData.Update;
begin
  FIsThemed := ThemeServices.ThemesAvailable and IsThemeActive and IsAppThemed;
  if not FIsThemed then
    Exit;

  if FCaptionButtons = nil then
    FCaptionButtons := TBitmapAdapter.Create;

  FBitmapValid := GetXPCaptionButtonBitmap(FCaptionButtons, FCaptionButtonCount);
  if FBitmapValid then
    FCaptionButtonHeight := FCaptionButtons.Height div FCaptionButtonCount
  else
    FreeAndNil(FCaptionButtons);
end;

{$ENDIF JVCLThemesEnabled}

//=== { TJvCaptionButton } ===================================================

constructor TJvCaptionButton.Create(AOwner: TComponent);
begin
  if not (AOwner is TCustomForm) then
    raise EJVCLException.CreateRes(@RsEOwnerMustBeTCustomForm);

  inherited Create(AOwner);

  { Defaults }
  FAlignment := taLeftJustify;
  FHeight := 0;
  FLeft := 0;
  FTop := 0;
  FWidth := 0;
  FEnabled := True;
  FImageIndex := -1;
  FLayout := cbImageLeft;
  FMargin := -1;
  FPosition := 0;
  FSpacing := 4;
  FStandard := tsbNone;
  FToggle := False;
  FVisible := True;

  FNeedRecalculate := True;
  FCaption := '';
  FDown := False;
  FToolTipHandle := 0;

  FFont := TFont.Create;
  FBuffer := TBitmap.Create;

  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FParentShowHint := True;

  {$IFDEF JVCLThemesEnabled}
  GlobalXPData.AddClient;
  {$ENDIF JVCLThemesEnabled}

  Hook;
end;

destructor TJvCaptionButton.Destroy;
begin
  DestroyToolTip;

  UnHook;
  Redraw(rkTotalCaptionBar);

  FFont.Free;
  FBuffer.Free;

  FreeAndNil(FActionLink);
  FreeAndNil(FImageChangeLink);

  {$IFDEF JVCLThemesEnabled}
  GlobalXPData.RemoveClient;
  {$ENDIF JVCLThemesEnabled}

  inherited Destroy;
end;

procedure TJvCaptionButton.ActionChange(Sender: TObject;
  CheckDefaults: Boolean);
begin
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults or not Assigned(Self.Images) then
        Self.Images := ActionList.Images;
      if not CheckDefaults or (Self.Caption = '') then
        Self.Caption := Caption;
      if not CheckDefaults or Self.Enabled then
        Self.Enabled := Enabled;
      if not CheckDefaults or (Self.Hint = '') then
        Self.Hint := Hint;
      if not CheckDefaults or (Self.ImageIndex = -1) then
        Self.ImageIndex := ImageIndex;
      if not CheckDefaults or Self.Visible then
        Self.Visible := Visible;
      if not CheckDefaults or not Assigned(Self.OnClick) then
        Self.OnClick := OnExecute;
    end;
end;

procedure TJvCaptionButton.Assign(Source: TPersistent);
begin
  if Source is TJvCaptionButton then
  begin
    Alignment := TJvCaptionButton(Source).Alignment;
    ButtonHeight := TJvCaptionButton(Source).ButtonHeight;
    ButtonLeft := TJvCaptionButton(Source).ButtonLeft;
    ButtonTop := TJvCaptionButton(Source).ButtonTop;
    ButtonWidth := TJvCaptionButton(Source).ButtonWidth;
    Caption := TJvCaptionButton(Source).Caption;
    ShowHint := TJvCaptionButton(Source).ShowHint;
    ParentShowHint := TJvCaptionButton(Source).ParentShowHint;
    Enabled := TJvCaptionButton(Source).Enabled;
    Font := TJvCaptionButton(Source).Font;
    Hint := TJvCaptionButton(Source).Hint;
    ImageIndex := TJvCaptionButton(Source).ImageIndex;
    Images := TJvCaptionButton(Source).Images;
    Layout := TJvCaptionButton(Source).Layout;
    Margin := TJvCaptionButton(Source).Margin;
    Position := TJvCaptionButton(Source).Position;
    Spacing := TJvCaptionButton(Source).Spacing;
    Standard := TJvCaptionButton(Source).Standard;
    // set toggle before down
    Toggle := TJvCaptionButton(Source).Toggle;
    Down := TJvCaptionButton(Source).Down;
    Visible := TJvCaptionButton(Source).Visible;
  end
  else
    inherited Assign(Source);
end;

procedure TJvCaptionButton.CalcButtonParts(ACanvas: TCanvas;
  ButtonRect: TRect; var RectText, RectImage: TRect);
// copied from TJvCustomImageButton
const
  CDefaultMargin = 4;
var
  BlockWidth, ButtonWidth, ButtonHeight, BlockMargin, InternalSpacing: Integer;
  LMargin: Integer;
  OldFont: TFont;
begin
  SetRect(RectText, 0, 0, 0, 0);
  OldFont := ACanvas.Font;
  ACanvas.Font := Font;
  DrawText(ACanvas, Caption, -1, RectText, DT_CALCRECT or Alignments[FAlignment]);
  ACanvas.Font := OldFont;
  if IsImageVisible then
  begin
    with Images do
      SetRect(RectImage, 0, 0, Width - 1, Height - 1);
    InternalSpacing := Spacing;
  end
  else
  begin
    SetRect(RectImage, 0, 0, 0, 0);
    InternalSpacing := 0;
  end;
  BlockWidth := RectImage.Right + InternalSpacing + RectText.Right;
  ButtonWidth := ButtonRect.Right - ButtonRect.Left;
  if Margin = -1 then
    LMargin := CDefaultMargin
  else
    LMargin := Margin;

  case Alignment of
    taLeftJustify:
      BlockMargin := LMargin;
    taRightJustify:
      BlockMargin := ButtonWidth - BlockWidth - LMargin - 1;
  else {taCenter}
    BlockMargin := (ButtonWidth - BlockWidth) div 2
  end;
  case Layout of
    cbImageLeft:
      begin
        OffsetRect(RectImage, BlockMargin, 0);
        OffsetRect(RectText, RectImage.Right + InternalSpacing, 0);
      end;
    cbImageRight:
      begin
        OffsetRect(RectText, BlockMargin, 0);
        OffsetRect(RectImage, RectText.Right + InternalSpacing, 0);
      end;
  end;
  ButtonHeight := ButtonRect.Bottom - ButtonRect.Top;
  OffsetRect(RectImage, ButtonRect.Left, (ButtonHeight - RectImage.Bottom) div 2 + ButtonRect.Top);
  OffsetRect(RectText, ButtonRect.Left, (ButtonHeight - RectText.Bottom) div 2 + ButtonRect.Top);
end;

procedure TJvCaptionButton.CalcDefaultButtonRect(Wnd: THandle);
const
  CSpaceBetweenButtons = 2;
var
  Style: DWORD;
  ExStyle: DWORD;
  FrameSize: TSize;
begin
  if Wnd = 0 then
    Exit;

  { 0. Init some local vars }
  FNeedRecalculate := False;
  Style := GetWindowLong(Wnd, GWL_STYLE);
  FHasCaption := Style and WS_CAPTION = WS_CAPTION;
  if not FHasCaption then
    Exit;

  ExStyle := GetWindowLong(Wnd, GWL_EXSTYLE);
  FHasSmallCaption := ExStyle and WS_EX_TOOLWINDOW = WS_EX_TOOLWINDOW;
  {$IFDEF JVCLThemesEnabled}
  FCaptionActive := (GetActiveWindow = Wnd) and IsForegroundTask;
  {$ENDIF JVCLThemesEnabled}

  if Style and WS_THICKFRAME = WS_THICKFRAME then
  begin
    FrameSize.cx := GetSystemMetrics(SM_CXSIZEFRAME);
    FrameSize.cy := GetSystemMetrics(SM_CYSIZEFRAME);
  end
  else
  begin
    FrameSize.cx := GetSystemMetrics(SM_CXFIXEDFRAME);
    FrameSize.cy := GetSystemMetrics(SM_CYFIXEDFRAME);
  end;

  { 1. Calc FDefaultButtonTop }
  FDefaultButtonTop := FrameSize.cy + 2;

  { 2. Calc FDefaultButtonHeight }
  if FHasSmallCaption then
    FCaptionHeight := GetSystemMetrics(SM_CYSMCAPTION)
  else
    FCaptionHeight := GetSystemMetrics(SM_CYCAPTION);
  FDefaultButtonHeight := FCaptionHeight - 5;

  { 3. Calc FDefaultButtonWidth }
  {$IFDEF JVCLThemesEnabled}
  if IsThemed then
    FDefaultButtonWidth := FDefaultButtonHeight
  else
  {$ENDIF JVCLThemesEnabled}
  if FHasSmallCaption then
    FDefaultButtonWidth := GetSystemMetrics(SM_CXSMSIZE) - CSpaceBetweenButtons
  else
    FDefaultButtonWidth := GetSystemMetrics(SM_CXSIZE) - CSpaceBetweenButtons;

  { 4. Calc FDefaultButtonLeft }
  FDefaultButtonLeft := FrameSize.cx;
  Inc(FDefaultButtonLeft, FDefaultButtonWidth + CSpaceBetweenButtons);

  if Style and WS_SYSMENU = WS_SYSMENU then
  begin
    { 4a. Avoid close button }
    Inc(FDefaultButtonLeft, FDefaultButtonWidth + CSpaceBetweenButtons);

    if not FHasSmallCaption then
    begin
      if (Style and WS_MAXIMIZEBOX = WS_MAXIMIZEBOX) or
        (Style and WS_MINIMIZEBOX = WS_MINIMIZEBOX) then
      begin
        {$IFDEF JVCLThemesEnabled}
        if IsThemed then
          { 4b. If it have Max or Min button, both are visible. When themed
                the CONTEXTHELP button is then never visible }
          Inc(FDefaultButtonLeft, 2 * (FDefaultButtonWidth + CSpaceBetweenButtons))
        else
        {$ENDIF JVCLThemesEnabled}
        begin
          { 4b. If it have Max or Min button, both are visible. }
          Inc(FDefaultButtonLeft, 2 * FDefaultButtonWidth + CSpaceBetweenButtons);

          { 4c. If it have CONTEXTHELP button, avoid it. }
          if ((Style and WS_MAXIMIZEBOX = 0) or (Style and WS_MINIMIZEBOX = 0)) and
            (ExStyle and WS_EX_CONTEXTHELP = WS_EX_CONTEXTHELP) then
            Inc(FDefaultButtonLeft, FDefaultButtonWidth + 2 * CSpaceBetweenButtons);
        end;
      end
      else
      { 4c. If it have CONTEXTHELP button, avoid it. }
      if ExStyle and WS_EX_CONTEXTHELP = WS_EX_CONTEXTHELP then
        Inc(FDefaultButtonLeft, FDefaultButtonWidth + CSpaceBetweenButtons);
    end;
  end;
end;

procedure TJvCaptionButton.Click;
begin
  if csDesigning in ComponentState then
    DesignerSelectComponent(Self)
  else
  if Enabled then
  begin
    { Call OnClick if assigned and not equal to associated action's OnExecute.
      If associated action's OnExecute assigned then call it, otherwise, call
      OnClick. }
    if Assigned(FOnClick) and (Action <> nil) and (@FOnClick <> @Action.OnExecute) then
      FOnClick(Self)
    else
    if {not (csDesigning in ComponentState) and} Assigned(ActionLink) then
      FActionLink.Execute{$IFDEF COMPILER6_UP}(Self){$ENDIF}
    else
    if Assigned(FOnClick) then
      FOnClick(Self);
  end;
end;

procedure TJvCaptionButton.CreateToolTip(Wnd: THandle);
var
  ToolInfo: TToolInfo;
begin
  if csDesigning in ComponentState then
    Exit;

  DestroyToolTip;

  if Wnd = 0 then
    Exit;

  FToolTipHandle := CreateWindowEx(0, TOOLTIPS_CLASS, nil, TTS_ALWAYSTIP,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    ParentForm.Handle, // Thus automatically destroyed if ParentForm handle is destroyed.
    0, HInstance, nil);

  if FToolTipHandle = 0 then
    Exit;

  // initialize tooltip info
  ToolInfo.cbSize := SizeOf(TToolInfo);
  ToolInfo.uFlags := TTF_IDISHWND; { Thus ignores rect param }
  ToolInfo.hwnd := Wnd;
  ToolInfo.uId := Wnd;
  ToolInfo.lpszText := LPSTR_TEXTCALLBACK;

  // register button with tooltip
  SendMessage(FToolTipHandle, TTM_ADDTOOL, 0, Integer(@ToolInfo));
end;

procedure TJvCaptionButton.DestroyToolTip;
begin
  if FToolTipHandle <> 0 then
  begin
    DestroyWindow(FToolTipHandle);
    FToolTipHandle := 0;
  end;
end;

procedure TJvCaptionButton.DoActionChange(Sender: TObject);
begin
  if Sender = Action then
    ActionChange(Sender, False);
end;

procedure TJvCaptionButton.DrawButton(DC: HDC);
var
  Canvas: TControlCanvas;
begin
  if not Visible or not FHasCaption or (csDestroying in ComponentState) then
    Exit;

  Canvas := TControlCanvas.Create;
  try
    Canvas.Handle := DC;

    UpdateButtonRect(ParentFormHandle);

    with FButtonRect do
    begin
      FBuffer.Width := Right - Left;
      FBuffer.Height := Bottom - Top;
    end;

    {$IFDEF JVCLThemesEnabled}
    DrawButtonBackground(FBuffer.Canvas);
    {$ENDIF JVCLThemesEnabled}

    { We do a buffered drawing, otherwise you get flickering on XP, and you
      have to hassle with the clipping rects. }
    if FStandard <> tsbNone then
      DrawStandardButton(FBuffer.Canvas)
    else
      DrawNonStandardButton(FBuffer.Canvas);

    Canvas.Draw(FButtonRect.Left, FButtonRect.Top, FBuffer);
  finally
    Canvas.Handle := 0;
    Canvas.Free;
  end;
end;

{$IFDEF JVCLThemesEnabled}
procedure TJvCaptionButton.DrawButtonBackground(ACanvas: TCanvas);
const
  CCaption: array [Boolean, Boolean] of TThemedWindow =
   (
    (twCaptionInactive, twCaptionActive),
    (twSmallCaptionInactive, twSmallCaptionActive)
   );
var
  Details: TThemedElementDetails;
  ClipRect: TRect;
  CaptionRect: TRect;
begin
  if not IsThemed or (csDestroying in ComponentState) then
    Exit;

  { We basically draw the background to display 4 pixels - the corners of the
    rect - correct <g>. Don't know a better way to do this. }

  { Determine the rect of the caption }
  GetWindowRect(ParentFormHandle, CaptionRect);
  OffsetRect(CaptionRect, -CaptionRect.Left, -CaptionRect.Top);
  CaptionRect.Bottom := FCaptionHeight + 4;
  { Offset it so the place where the button is, is at (0, 0) }
  OffsetRect(CaptionRect, -FButtonRect.Left, -FButtonRect.Top);
  with FButtonRect do
    ClipRect := Rect(0, 0, Right - Left, Bottom - Top);

  Details := ThemeServices.GetElementDetails(CCaption[FHasSmallCaption, FCaptionActive]);
  ThemeServices.DrawElement(ACanvas.Handle, Details, CaptionRect, @ClipRect);
end;
{$ENDIF JVCLThemesEnabled}

procedure TJvCaptionButton.DrawButtonImage(ACanvas: TCanvas; ImageBounds: TRect);
begin
  if csDestroying in ComponentState then
    Exit;
  with ImageBounds do
    if IsImageVisible then
      Images.Draw(ACanvas, Left, Top, ImageIndex, Enabled);
end;

procedure TJvCaptionButton.DrawButtonText(ACanvas: TCanvas; TextBounds: TRect);
var
  Flags: DWORD;
  OldFont: TFont;
begin
  Flags := DT_VCENTER or Alignments[FAlignment];
  with ACanvas do
  begin
    Brush.Style := bsClear;
    if not Enabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      OldFont := Font;
      Font := Self.Font;
      Font.Color := clBtnHighlight;
      DrawText(ACanvas, Caption, Length(Caption), TextBounds, Flags);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(ACanvas, Caption, Length(Caption), TextBounds, Flags);
      Font := OldFont;
    end
    else
    begin
      OldFont := Font;
      Font := Self.Font;
      DrawText(ACanvas, Caption, Length(Caption), TextBounds, Flags);
      Font := OldFont;
    end;
  end;
end;

procedure TJvCaptionButton.DrawNonStandardButton(ACanvas: TCanvas);
{$IFDEF JVCLThemesEnabled}
const
  cState_Normal = 1;
  cState_Hot = 2;
  cState_Pushed = 3;
  cState_Disabled = 4;
{$ENDIF JVCLThemesEnabled}
var
  DrawRect: TRect;
  RectText, RectImage: TRect;
  {$IFDEF JVCLThemesEnabled}
  State: Integer;
  DrawRgn: HRGN;
  {$ENDIF JVCLThemesEnabled}
begin
  if csDestroying in ComponentState then
    Exit;
  with FButtonRect do
    DrawRect := Rect(0, 0, Right - Left, Bottom - Top);

  {$IFDEF JVCLThemesEnabled}
  // Satisfy the compiler
  DrawRgn := 0;

  { 1. Draw the button }
  if IsThemed then
  begin
    if not Enabled then
      State := 4
    else
    if FDown then
      State := 3
    else
    if FMouseInControl then
      State := 2
    else
      State := 1;

    { Special state for buttons drawn on a not active caption }
    if not FCaptionActive then
      Inc(State, 4);

    if ForceDrawSimple or not GlobalXPData.Draw(ACanvas, State, DrawRect) then
      GlobalXPData.DrawSimple(ACanvas, State, DrawRect)
  end
  else
  {$ENDIF JVCLThemesEnabled}
    DrawButtonFace(ACanvas, DrawRect, 1, bsAutoDetect, False, FDown, False);

  { 2. Draw the text & picture }
  {$IFDEF JVCLThemesEnabled}
  if IsThemed then
  begin
    { 2a. If themed, only draw in the inner bit of the button using a clip region }
    with DrawRect do
      DrawRgn := CreateRectRgn(Left + 2, Top + 2, Right - 2, Bottom - 2);

    SelectClipRgn(ACanvas.Handle, DrawRgn);
  end;
  {$ENDIF JVCLThemesEnabled}

  if FDown then
  begin
    {$IFDEF JVCLThemesEnabled}
    if IsThemed then
      OffsetRect(DrawRect, 1, 0)
    else
    {$ENDIF JVCLThemesEnabled}
      OffsetRect(DrawRect, 1, 1);
  end;
  { 2b. Calc position and Draw the picture & text }
  CalcButtonParts(ACanvas, DrawRect, RectText, RectImage);
  DrawButtonText(ACanvas, RectText);
  DrawButtonImage(ACanvas, RectImage);
  { 2c. Clean up }
  {$IFDEF JVCLThemesEnabled}
  if IsThemed then
  begin
    SelectClipRgn(ACanvas.Handle, 0);
    DeleteObject(DrawRgn);
  end;
  {$ENDIF JVCLThemesEnabled}
end;

procedure TJvCaptionButton.DrawStandardButton(ACanvas: TCanvas);
const
  {$IFDEF JVCLThemesEnabled}
  CElements: array [TJvStandardButton] of TThemedWindow =
   (twWindowDontCare, twCloseButtonNormal, twHelpButtonNormal, twMaxButtonNormal,
    twMinButtonNormal, twRestoreButtonNormal, twMinButtonNormal);
  {$ENDIF JVCLThemesEnabled}
  CDrawFlags: array [TJvStandardButton] of Word =
   (0, DFCS_CAPTIONCLOSE, DFCS_CAPTIONHELP, DFCS_CAPTIONMAX, DFCS_CAPTIONMIN,
    DFCS_CAPTIONRESTORE, 0);
  CDown: array [Boolean] of Word = (0, DFCS_PUSHED);
  CEnabled: array [Boolean] of Word = (DFCS_INACTIVE, 0);
var
  DrawRect: TRect;
  {$IFDEF JVCLThemesEnabled}
  Details: TThemedElementDetails;
  CaptionButton: TThemedWindow;
  {$ENDIF JVCLThemesEnabled}
begin
  if csDestroying in ComponentState then
    Exit;
  with FButtonRect do
    DrawRect := Rect(0, 0, Right - Left, Bottom - Top);

  {$IFDEF JVCLThemesEnabled}
  if IsThemed then
  begin
    CaptionButton := CElements[FStandard];
    { Note : There is only a small close button (??) }
    if FHasSmallCaption and (FStandard = tsbClose) then
      CaptionButton := twSmallCloseButtonNormal;

    if not Enabled then
      Inc(CaptionButton, 3)
    else
    if FDown then
      { If Down and inactive, draw inactive border }
      Inc(CaptionButton, 2)
    else
    if FMouseInControl then
      Inc(CaptionButton);

    Details := ThemeServices.GetElementDetails(CaptionButton);
    { Special state for buttons drawn on a not active caption }
    if not FCaptionActive and (Details.State = 1) then
      Details.State := 5;
    ThemeServices.DrawElement(ACanvas.Handle, Details, DrawRect)
  end
  else
  {$ENDIF JVCLThemesEnabled}
  if Standard = tsbMinimizeToTray then
  begin
    DrawButtonFace(ACanvas, DrawRect, 1, bsAutoDetect, False, FDown, False);
    if Enabled then
    begin
      ACanvas.Brush.Color := clWindowText;
      with DrawRect do
        ACanvas.FillRect(Rect(Right - 7, Bottom - 5, Right - 4, Bottom - 3));
    end
    else
    begin
      ACanvas.Brush.Color := clBtnHighlight;
      with DrawRect do
        ACanvas.FillRect(Rect(Right - 6, Bottom - 4, Right - 3, Bottom - 2));
      ACanvas.Brush.Color := clBtnShadow;
      with DrawRect do
        ACanvas.FillRect(Rect(Right - 7, Bottom - 5, Right - 4, Bottom - 3));
    end;
  end
  else
    DrawFrameControl(ACanvas.Handle, DrawRect, DFC_CAPTION, {DFCS_ADJUSTRECT or}
      CDrawFlags[Standard] or CDown[Down] or CEnabled[Enabled]);
end;

procedure TJvCaptionButton.ForwardToToolTip(Msg: TMessage);
var
  ForwardMsg: TMsg;
begin
  if FToolTipHandle = 0 then
    Exit;

  // forward to tool tip
  ForwardMsg.lParam := Msg.LParam;
  ForwardMsg.wParam := Msg.WParam;
  ForwardMsg.message := Msg.Msg;
  ForwardMsg.hwnd := ParentFormHandle;
  SendMessage(FToolTipHandle, TTM_RELAYEVENT, 0, Integer(@ForwardMsg));
end;

function TJvCaptionButton.GetAction: TBasicAction;
begin
  if FActionLink <> nil then
    Result := FActionLink.Action
  else
    Result := nil;
end;

function TJvCaptionButton.GetActionLinkClass: TJvCaptionButtonActionLinkClass;
begin
  Result := TJvCaptionButtonActionLink;
end;

function TJvCaptionButton.GetIsImageVisible: Boolean;
begin
  Result := Assigned(Images) and (ImageIndex > -1) and (ImageIndex < Images.Count);
end;

{$IFDEF JVCLThemesEnabled}
function TJvCaptionButton.GetIsThemed: Boolean;
begin
  Result := GlobalXPData.IsThemed;
end;
{$ENDIF JVCLThemesEnabled}

function TJvCaptionButton.GetParentForm: TCustomForm;
begin
  if Owner is TControl then
    Result := Forms.GetParentForm(TControl(Owner))
  else
    Result := nil;
end;

function TJvCaptionButton.GetParentFormHandle: THandle;
var
  P: TCustomForm;
begin
  P := GetParentForm;
  if Assigned(P) and P.HandleAllocated then
    Result := P.Handle
  else
    Result := 0;
end;

function TJvCaptionButton.HandleButtonDown(var Msg: TWMNCHitMessage): Boolean;
begin
  Result := Visible and Enabled and (Msg.HitTest = htCaptionButton) and
    MouseOnButton(Msg.XCursor, Msg.YCursor, False);

  if Result then
  begin
    FMouseButtonDown := True;
    if Toggle then
      FDown := not FDown
    else
      FDown := True;
    with TWMMouse(Msg) do
      MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
    {if not Toggle then}
    SetCapture(ParentFormHandle);
    Redraw(rkIndirect);

    { Note: If Toggle = False -> click event is fired in HandleButtonUp }
    if Toggle then
      Click;
  end
  else
  if FDown and not Toggle then
  begin
    FMouseButtonDown := False;
    FDown := False;
    Redraw(rkIndirect);
  end;
end;

function TJvCaptionButton.HandleButtonUp(var Msg: TWMNCHitMessage): Boolean;
var
  DoClick: Boolean;
  P: TPoint;
begin
  Result := False;

  if not FMouseButtonDown then
    Exit;

  Result := FDown and MouseOnButton(Msg.XCursor, Msg.YCursor, Msg.Msg = WM_LBUTTONUP);
  { Note: If Toggle = True -> click event is fired in HandleButtonDown }
  DoClick := Result and not Toggle;

  FMouseButtonDown := False;
  ReleaseCapture;

  if not Toggle then
  begin
    FDown := False;
    Redraw(rkIndirect);
  end;

  if DoClick then
    Click;

  //(p3) we need to convert MouseUp message because they are in client coordinates (MouseDown are already in screen coords, so no need to change)
  with TWMMouse(Msg) do
  begin
    P := Point(XPos, YPos);
    Assert(ParentForm <> nil, '');
    P := ParentForm.ClientToScreen(P);
    MouseUp(mbLeft, KeysToShiftState(Keys), P.X, P.Y);
  end;
end;

function TJvCaptionButton.HandleHitTest(var Msg: TWMNCHitTest): Boolean;
var
  CurPos: TPoint;
begin
  Result := Visible and MouseOnButton(Msg.XPos, Msg.YPos, False);
  if Result then
    Msg.Result := htCaptionButton;

  if not Result and Visible and MouseInControl then
  begin
    // We can get weird hittest values (probably from the hint window) so
    // double check that the mouse is not on the button.
    // Actually we wrongfully assumed that Msg represents the current mouse
    // position so we have to double check.
    GetCursorPos(CurPos);
    if not MouseOnButton(CurPos.X, CurPos.Y, False) then
    begin
      SetMouseInControl(False);
      Redraw(rkIndirect);
    end;
  end;

  //Result := False;
end;

function TJvCaptionButton.HandleMouseMove(var Msg: TWMNCHitMessage): Boolean;
var
  DoRedraw: Boolean;
  MouseWasInControl: Boolean;
begin
  Result := FMouseButtonDown;

  if Result then
  begin
    MouseWasInControl := FMouseInControl;
    SetMouseInControl(MouseOnButton(Msg.XCursor, Msg.YCursor, Msg.Msg = WM_MOUSEMOVE));
    DoRedraw := (FMouseInControl <> MouseWasInControl) or
      // User presses mouse button, but left the caption button
      (FDown and not Toggle and not FMouseInControl) or
      // User presses mouse button, and enters the caption button
      (not FDown and not Toggle and FMouseInControl);

    FDown := (FDown and Toggle) or
      (FMouseButtonDown and not Toggle and FMouseInControl);
    if DoRedraw then
      Redraw(rkIndirect);
  end;
  // (p3) don't handle mouse move here: it is triggered even if the mouse is outside the button
  //  with TWmMouseMove(Msg) do
  //    MouseMove(KeysToShiftState(Keys), XPos, YPos);
end;

procedure TJvCaptionButton.HandleNCActivate(var Msg: TWMNCActivate);
begin
  {$IFDEF JVCLThemesEnabled}
  FCaptionActive := Msg.Active;
  {$ENDIF JVCLThemesEnabled}
  SetMouseInControl(MouseInControl and Msg.Active);

  Redraw(rkDirect);
end;

procedure TJvCaptionButton.HandleNCMouseMove(var Msg: TWMNCHitMessage);
var
  IsOnButton: Boolean;
begin
  IsOnButton := MouseOnButton(Msg.XCursor, Msg.YCursor, False);
  if Visible then
  begin
    if (IsOnButton <> FMouseInControl) then
    begin
      SetMouseInControl(not FMouseInControl);
      if not Down then
        Redraw(rkIndirect);
    end;
   // (p3) only handle mouse move if we are inside the button or it will be triggered for the entire NC area
    if IsOnButton then
      with TWMMouseMove(Msg) do
        MouseMove(KeysToShiftState(Keys), XPos, YPos);
  end;
end;

procedure TJvCaptionButton.HandleNCPaintAfter(Wnd: THandle; var Msg: TWMNCPaint);
begin
  if FRgnChanged then
  begin
    DeleteObject(Msg.RGN);
    Msg.RGN := FSaveRgn;
    FRgnChanged := False;
  end;

  Redraw(rkDirect);
end;

procedure TJvCaptionButton.HandleNCPaintBefore(Wnd: THandle; var Msg: TWMNCPaint);
var
  WindowRect: TRect;
  DrawRgn: HRGN;
  LButtonRect: TRect;
begin
  { Note: There is one problem with this reduce flickering method: This
          function is executed before windows handles the WM_NCPAINT and
          HandleNCPaintAfter is executed after windows handles WM_NCPAINT.

          When you resize a form, the value returned by API GetWindowRect is
          adjusted when windows handles the WM_NCPAINT.

          Thus return value of GetWindowRect in HandleNCPaintBefore differs
          from return value of GetWindowRect in HandleNCPaintAfter.
        ->
          Thus value of FButtonRect in HandleNCPaintBefore differs
          from return value of FButtonRect in HandleNCPaintAfter.

          (Diff is typically 1 pixel)

          This causes a light flickering at the edge of the button when
          you resize the form.

          To see it, put Sleep(1000) or so, before and after the DrawButton call
          in HandleNCPaintAfter and resize the screen horizontally
  }
  if Wnd = 0 then
    Exit;

  FSaveRgn := Msg.RGN;
  FRgnChanged := False;
  { Calculate button rect in screen coordinates, put it in LButtonRect }
  UpdateButtonRect(Wnd);
  LButtonRect := FButtonRect;
  GetWindowRect(Wnd, WindowRect);
  OffsetRect(LButtonRect, WindowRect.Left, WindowRect.Top);
  { Check if button rect is in the to be updated region.. }
  if RectInRegion(FSaveRgn, LButtonRect) then
  begin
    { ..If so remove the button rectangle from the region (otherwise the caption
      background would be drawn over the button, which causes flicker) }
    with LButtonRect do
      DrawRgn := CreateRectRgn(Left, Top, Right, Bottom);
    try
      Msg.RGN := CreateRectRgn(0, 0, 1, 1);
      FRgnChanged := True;
      CombineRgn(Msg.RGN, FSaveRgn, DrawRgn, RGN_DIFF);
    finally
      DeleteObject(DrawRgn);
    end;
  end;
end;

function TJvCaptionButton.HandleNotify(var Msg: TWMNotify): Boolean;
var
  CurPos: TPoint;
  LButtonRect, WindowRect: TRect;
begin
  // if we receive a TTN_GETDISPINFO notification
  // and it is from the tooltip
  Result := (Msg.NMHdr.code = TTN_NEEDTEXT) and (Msg.NMHdr.hwndFrom = FToolTipHandle);

  if Result and (ShowHint or (ParentShowHint and ParentForm.ShowHint)) then
  begin
    // get cursor position
    GetCursorPos(CurPos);
    GetWindowRect(ParentFormHandle, WindowRect);
    LButtonRect := FButtonRect;
    OffsetRect(LButtonRect, WindowRect.Left, WindowRect.Top);

    // if the mouse is in the area of the button
    if PtInRect(LButtonRect, CurPos) then
      if Msg.NMHdr.code = TTN_NEEDTEXTA then
      begin
        with PNMTTDispInfoA(Msg.NMHdr)^ do
        begin
          // then we return the hint
          lpszText := PChar(FHint);
          hinst := 0;
          uFlags := TTF_IDISHWND;
          hdr.idFrom := ParentFormHandle;
        end;
      end
      else
        with PNMTTDispInfoW(Msg.NMHdr)^ do
        begin
          // then we return the hint
          lpszText := PWideChar(WideString(FHint));
          hinst := 0;
          uFlags := TTF_IDISHWND;
          hdr.idFrom := ParentFormHandle;
        end
    else
      //else we hide the tooltip
      HideToolTip;
  end;
end;

procedure TJvCaptionButton.HideToolTip;
begin
  if FToolTipHandle <> 0 then
    SendMessage(FToolTipHandle, TTM_POP, 0, 0);
end;

procedure TJvCaptionButton.Hook;
var
  P: TCustomForm;
begin
  //if not Visible or not FHasCaption then
  // Exit;

  P := ParentForm;
  if Assigned(P) then
  begin
    RegisterWndProcHook(P, WndProcAfter, hoAfterMsg);
    RegisterWndProcHook(P, WndProcBefore, hoBeforeMsg);

    if P.HandleAllocated then
      CreateToolTip(P.Handle);
  end;
end;

procedure TJvCaptionButton.ImageListChange(Sender: TObject);
begin
  if Sender = Images then
    Redraw(rkIndirect);
end;

procedure TJvCaptionButton.InitiateAction;
begin
  if FActionLink <> nil then
    FActionLink.Update;
end;

function TJvCaptionButton.IsCaptionStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsCaptionLinked;
end;

function TJvCaptionButton.IsEnabledStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsEnabledLinked;
end;

function TJvCaptionButton.IsHintStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsHintLinked;
end;

function TJvCaptionButton.IsImageIndexStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsImageIndexLinked;
end;

procedure TJvCaptionButton.Loaded;
begin
  inherited Loaded;

  CreateToolTip(ParentFormHandle);
  Redraw(rkTotalCaptionBar);
end;

procedure TJvCaptionButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TJvCaptionButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;

function TJvCaptionButton.MouseOnButton(X, Y: Integer;
  const TranslateToScreenCoord: Boolean): Boolean;
var
  WindowRect: TRect;
  Wnd: THandle;
  P: TPoint;
begin
  Wnd := ParentFormHandle;
  Result := Wnd <> 0;
  if not Result then
    Exit;

  P := Point(X, Y);
  if TranslateToScreenCoord then
    Windows.ClientToScreen(Wnd, P);

  GetWindowRect(Wnd, WindowRect);
  Result := PtInRect(FClickRect, Point(P.X - WindowRect.Left, P.Y - WindowRect.Top));
end;

procedure TJvCaptionButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TJvCaptionButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = Images) and (Operation = opRemove) then
    Images := nil;
end;

procedure TJvCaptionButton.Redraw(const AKind: TJvRedrawKind);
var
  Wnd: THandle;
  DC: HDC;
begin
  if csLoading in ComponentState then
    Exit;

  Wnd := ParentFormHandle;
  if Wnd = 0 then
    Exit;

  case AKind of
    rkDirect:
      begin
        DC := GetWindowDC(Wnd);
        try
          DrawButton(DC);
        finally
          ReleaseDC(Wnd, DC);
        end;
      end;
    rkIndirect:
      begin
        UpdateButtonRect(Wnd);
        RedrawWindow(Wnd, @FButtonRect, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE);
      end;
    rkTotalCaptionBar:
      begin
        UpdateButtonRect(Wnd);
        RedrawWindow(Wnd, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT or RDW_INVALIDATE);
      end;
  end;
end;

procedure TJvCaptionButton.ResetButton;
begin
  UnHook;
  Hook;
  Redraw(rkTotalCaptionBar);
end;

procedure TJvCaptionButton.SetAction(const Value: TBasicAction);
begin
  if Value = nil then
  begin
    FActionLink.Free;
    FActionLink := nil;
  end
  else
  begin
    if FActionLink = nil then
      FActionLink := GetActionLinkClass.Create(Self);
    FActionLink.Action := Value;
    FActionLink.OnChange := DoActionChange;
    ActionChange(Value, csLoading in Value.ComponentState);
    Value.FreeNotification(Self);
  end;
end;

procedure TJvCaptionButton.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    if Standard = tsbNone then
      Redraw(rkIndirect);
  end;
end;

procedure TJvCaptionButton.SetCaption(Value: string);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    if Standard = tsbNone then
      Redraw(rkIndirect);
  end;
end;

procedure TJvCaptionButton.SetDown(const Value: Boolean);
begin
  if (FDown <> Value) and Toggle then
  begin
    FDown := Value;
    Redraw(rkIndirect);
  end;
end;

procedure TJvCaptionButton.SetEnabled(const Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    Redraw(rkIndirect);
  end;
end;

procedure TJvCaptionButton.SetFont(Value: TFont);
begin
  if FFont <> Value then
  begin
    FFont.Assign(Value);
    if Standard = tsbNone then
      Redraw(rkIndirect);
  end;
end;

{$IFDEF JVCLThemesEnabled}
procedure TJvCaptionButton.SetForceDrawSimple(const Value: Boolean);
begin
  if FForceDrawSimple <> Value then
  begin
    FForceDrawSimple := Value;
    if IsThemed then
      Redraw(rkDirect);
  end;
end;
{$ENDIF JVCLThemesEnabled}

procedure TJvCaptionButton.SetHeight(Value: Integer);
begin
  if (FHeight <> Value) and (Value >= 0) then
  begin
    FHeight := Value;
    Redraw(rkTotalCaptionBar);
  end;
end;

procedure TJvCaptionButton.SetImageIndex(const Value: TImageIndex);
begin
  if Value <> FImageIndex then
  begin
    FImageIndex := Value;
    if Standard = tsbNone then
      Redraw(rkIndirect);
  end;
end;

procedure TJvCaptionButton.SetImages(const Value: TCustomImageList);
begin
  if FImages <> nil then
    FImages.UnRegisterChanges(FImageChangeLink);
  FImages := Value;
  if FImages <> nil then
  begin
    FImages.RegisterChanges(FImageChangeLink);
    FImages.FreeNotification(Self);
  end;
  if Standard = tsbNone then
    Redraw(rkIndirect);
end;

procedure TJvCaptionButton.SetLayout(const Value: TJvCaptionButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    if (csDesigning in ComponentState) and (FAlignment <> taCenter) then
      case FLayout of
        cbImageLeft: FAlignment := taLeftJustify;
        cbImageRight: FAlignment := taRightJustify;
      end;
    if (Standard = tsbNone) and IsImageVisible then
      Redraw(rkIndirect);
  end;
end;

procedure TJvCaptionButton.SetLeft(Value: Integer);
begin
  if FLeft <> Value then
  begin
    FLeft := Value;
    Redraw(rkTotalCaptionBar);
  end;
end;

procedure TJvCaptionButton.SetMargin(const Value: Integer);
begin
  if (FMargin <> Value) and (Value >= -1) then
  begin
    FMargin := Value;
    if Standard = tsbNone then
      Redraw(rkIndirect);
  end;
end;

procedure TJvCaptionButton.SetMouseInControl(const Value: Boolean);
begin
  if FMouseInControl <> Value then
  begin
    if not Value then
      HideToolTip;

    FMouseInControl := Value;
  end;
end;

procedure TJvCaptionButton.SetParentShowHint(const Value: Boolean);
begin
  if FParentShowHint <> Value then
  begin
    FParentShowHint := Value;
    if FParentShowHint then
      FShowHint := ParentForm.ShowHint;
  end;
end;

procedure TJvCaptionButton.SetPosition(const Value: Integer);
begin
  if FPosition <> Value then
  begin
    FPosition := Value;
    Redraw(rkTotalCaptionBar);
  end;
end;

procedure TJvCaptionButton.SetShowHint(const Value: Boolean);
begin
  if FShowHint <> Value then
  begin
    FShowHint := Value;
    FParentShowHint := False;
  end;
end;

procedure TJvCaptionButton.SetSpacing(const Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    if Standard = tsbNone then
      Redraw(rkIndirect);
  end;
end;

procedure TJvCaptionButton.SetStandard(Value: TJvStandardButton);
{$IFDEF JVCLThemesEnabled}
var
  ButtonSizeChanged: Boolean;
{$ENDIF JVCLThemesEnabled}
begin
  if FStandard <> Value then
  begin
    {$IFDEF JVCLThemesEnabled}
    ButtonSizeChanged := IsThemed and
      ((Value = tsbMinimizeToTray) or (FStandard = tsbMinimizeToTray));
    {$ENDIF JVCLThemesEnabled}
    FStandard := Value;

    {$IFDEF JVCLThemesEnabled}
    if ButtonSizeChanged then
      UpdateButtonRect(ParentFormHandle);

    if ButtonSizeChanged and (FStandard = tsbMinimizeToTray) then
      Redraw(rkTotalCaptionBar)
    else
    {$ENDIF JVCLThemesEnabled}
      Redraw(rkIndirect);
  end;
end;

procedure TJvCaptionButton.SetToggle(const Value: Boolean);
begin
  if FToggle <> Value then
  begin
    FToggle := Value;
    if FDown and not FToggle and not (FMouseInControl and FMouseButtonDown) then
    begin
      FDown := False;
      Redraw(rkIndirect);
    end;
  end;
end;

procedure TJvCaptionButton.SetTop(Value: Integer);
begin
  if FTop <> Value then
  begin
    FTop := Value;
    Redraw(rkTotalCaptionBar);
  end;
end;

procedure TJvCaptionButton.SetVisible(const Value: Boolean);
begin
  if Value <> FVisible then
  begin
    FVisible := Value;
    { Caption, RedrawButton doesn't draw the caption itself }
    Redraw(rkTotalCaptionBar);
  end;
end;

procedure TJvCaptionButton.SetWidth(Value: Integer);
begin
  if (FWidth <> Value) and (Value >= 0) then
  begin
    FWidth := Value;
    Redraw(rkTotalCaptionBar);
  end;
end;

procedure TJvCaptionButton.UnHook;
var
  P: TCustomForm;
begin
  P := ParentForm;
  if Assigned(P) then
  begin
    DestroyToolTip;
    UnRegisterWndProcHook(P, WndProcAfter, hoAfterMsg);
    UnRegisterWndProcHook(P, WndProcBefore, hoBeforeMsg);
  end;
end;

procedure TJvCaptionButton.UpdateButtonRect(Wnd: THandle);
var
  WindowRect: TRect;
  LButtonWidth: Integer;
  LButtonHeight: Integer;
begin
  if Wnd = 0 then
    Exit;

  if FNeedRecalculate then
    CalcDefaultButtonRect(Wnd);

  GetWindowRect(Wnd, WindowRect);

  if ButtonWidth <> 0 then
    LButtonWidth := ButtonWidth
  else
    LButtonWidth := FDefaultButtonWidth;

  if ButtonHeight <> 0 then
    LButtonHeight := ButtonHeight
  else
    LButtonHeight := FDefaultButtonHeight;

  FButtonRect := Bounds(
    WindowRect.Right - WindowRect.Left - FDefaultButtonLeft + ButtonLeft
    + FDefaultButtonWidth - LButtonWidth,
    FDefaultButtonTop + ButtonTop, LButtonWidth, LButtonHeight);

  OffsetRect(FButtonRect, -FPosition * (FDefaultButtonWidth + 2), 0);

  { Special }
  {$IFDEF JVCLThemesEnabled}
  if (FStandard = tsbMinimizeToTray) and IsThemed then
    Inc(FButtonRect.Top, 2);
  {$ENDIF JVCLThemesEnabled}

  { Click rect is a bit bigger }
  with FButtonRect do
    FClickRect := Rect(Left - 2, Top - 2, Right + 1, Bottom + 2);
end;

function TJvCaptionButton.WndProcAfter(var Msg: TMessage): Boolean;
begin
  { let others listen in too }
  Result := False;

  case Msg.Msg of
    {$IFDEF JVCLThemesEnabled}
    WM_THEMECHANGED,
    {$ENDIF JVCLThemesEnabled}
    CM_SYSCOLORCHANGE:
      begin
        FNeedRecalculate := True;
        {$IFDEF JVCLThemesEnabled}
        { force theme data refresh, needed when

          * Switching from 'windows classic' style to 'windows XP' style
            ( delphi 7 bug) }
        ThemeServices.UpdateThemes;
        GlobalXPData.Update;
        {$ENDIF JVCLThemesEnabled}
      end;
    CM_SYSFONTCHANGED:
      begin
        FNeedRecalculate := True;
        {$IFDEF JVCLThemesEnabled}
        { force theme data refresh, needed when

          * Non-themed application and switching system font size }
        if not ThemeServices.ThemesEnabled then
          ThemeServices.UpdateThemes;
        {$ENDIF JVCLThemesEnabled}
      end;
    WM_SETTEXT:
      { Caption text may overwrite the button, so redraw }
      Redraw(rkIndirect);
    WM_NCPAINT:
      HandleNCPaintAfter(ParentFormHandle, TWMNCPaint(Msg));
    WM_NCACTIVATE:
      HandleNCActivate(TWMNCActivate(Msg));
    CM_RECREATEWND:
      begin
        CreateToolTip(ParentFormHandle);
        FNeedRecalculate := True;
        //CalcDefaultButtonRect(ParentFormHandle);
        Redraw(rkTotalCaptionBar);
      end;
    WM_LBUTTONDOWN, WM_NCLBUTTONUP, WM_LBUTTONUP, WM_NCMOUSEMOVE, WM_NCRBUTTONUP,
    WM_RBUTTONUP, WM_NCRBUTTONDOWN, WM_RBUTTONDOWN, WM_NCLBUTTONDOWN:
      ForwardToToolTip(Msg);
  end;
end;

function TJvCaptionButton.WndProcBefore(var Msg: TMessage): Boolean;
begin
  case Msg.Msg of
    CM_SHOWHINTCHANGED:
      begin
        if ParentShowHint then
          FShowHint := ParentForm.ShowHint;
        Result := False;
      end;
    CM_MOUSELEAVE, CM_MOUSEENTER:
      begin
        if FMouseInControl then
        begin
          SetMouseInControl(False);
          Redraw(rkIndirect);
        end;
        Result := False;
      end;
    WM_NCLBUTTONDOWN: //, WM_LBUTTONDOWN:
      begin
        Result := HandleButtonDown(TWMNCHitMessage(Msg));
        if Result then
          ForwardToToolTip(Msg);
      end;
    WM_NCLBUTTONUP, WM_LBUTTONUP:
      begin
        Result := HandleButtonUp(TWMNCHitMessage(Msg));
        if Result then
          ForwardToToolTip(Msg);
      end;
    WM_MOUSEMOVE:
      begin
        Result := HandleMouseMove(TWMNCHitMessage(Msg));
        if Result then
          ForwardToToolTip(Msg);
      end;
    WM_NCMOUSEMOVE:
      begin
        Result := False;
        HandleNCMouseMove(TWMNCHitMessage(Msg));
      end;
    WM_NCHITTEST:
      Result := HandleHitTest(TWMNCHitTest(Msg));
    WM_NCPAINT:
      begin
        Result := False;
        HandleNCPaintBefore(ParentFormHandle, TWMNCPaint(Msg));
      end;
    WM_DESTROY:
      begin
        Result := False;
        {DestroyToolTip;}
        // FToolTipHandle is automatically destroyed when ParentForm handle is destroyed.
        FToolTipHandle := 0;
      end;
    WM_NOTIFY:
      Result := HandleNotify(TWMNotify(Msg));
  else
    Result := False;
  end;
end;

//=== { TJvCaptionButtonActionLink } =========================================

procedure TJvCaptionButtonActionLink.AssignClient(AClient: TObject);
begin
  FClient := AClient as TJvCaptionButton;
end;

function TJvCaptionButtonActionLink.IsCaptionLinked: Boolean;
begin
  Result := inherited IsCaptionLinked and
    AnsiSameText(FClient.Caption, (Action as TCustomAction).Caption);
end;

function TJvCaptionButtonActionLink.IsEnabledLinked: Boolean;
begin
  Result := inherited IsEnabledLinked and
    (FClient.Enabled = (Action as TCustomAction).Enabled);
end;

function TJvCaptionButtonActionLink.IsHintLinked: Boolean;
begin
  Result := inherited IsHintLinked and
    (FClient.Hint = (Action as TCustomAction).Hint);
end;

function TJvCaptionButtonActionLink.IsImageIndexLinked: Boolean;
begin
  Result := inherited IsImageIndexLinked and
    (FClient.ImageIndex = (Action as TCustomAction).ImageIndex);
end;

function TJvCaptionButtonActionLink.IsOnExecuteLinked: Boolean;
begin
  Result := inherited IsOnExecuteLinked and
    (@FClient.OnClick = @Action.OnExecute);
end;

function TJvCaptionButtonActionLink.IsVisibleLinked: Boolean;
begin
  Result := inherited IsVisibleLinked and
    (FClient.Visible = (Action as TCustomAction).Visible);
end;

procedure TJvCaptionButtonActionLink.SetCaption(const Value: string);
begin
  if IsCaptionLinked then
    FClient.Caption := Value;
end;

procedure TJvCaptionButtonActionLink.SetEnabled(Value: Boolean);
begin
  if IsEnabledLinked then
    FClient.Enabled := Value;
end;

procedure TJvCaptionButtonActionLink.SetHint(const Value: string);
begin
  if IsHintLinked then
    FClient.Hint := Value;
end;

procedure TJvCaptionButtonActionLink.SetImageIndex(Value: Integer);
begin
  if IsImageIndexLinked then
    FClient.ImageIndex := Value;
end;

procedure TJvCaptionButtonActionLink.SetOnExecute(Value: TNotifyEvent);
begin
  if IsOnExecuteLinked then
    FClient.OnClick := Value;
end;

procedure TJvCaptionButtonActionLink.SetVisible(Value: Boolean);
begin
  if IsVisibleLinked then
    FClient.Visible := Value;
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

finalization
  UnloadMsimg32Dll;
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.