lazarus-ccr/components/jvcllaz/run/JvXPBar.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: JvXPBar.PAS, released on 2004-01-01.

The Initial Developer of the Original Code is Marc Hoffman.
Portions created by Marc Hoffman are Copyright (C) 2002 APRIORI business solutions AG.
Portions created by APRIORI business solutions AG are Copyright (C) 2002 APRIORI business solutions AG
All Rights Reserved.

Contributor(s): dejoy
  //dejoy 2004-4-20
  --add GroupIndex,AutoCheck,Checked property in TJvXPBarItem.
  --add GetItemClass in TJvXPBarItems.
  --add GetBarItemsClass in TJvXPCustomWinXPBar.

Contributor(s): dierk schmid
  //dierk 2004-4-23
  --add property RoundedItemFrame in TJvXPCustomWinXPBar (Integer>0 is the edge radius)
  --add property ItemFrameColor in TJvXPBarColors
  //dejoy 2004-4-25
  -- splitt ItemFrameColor to CheckedFrameColor , FocusedFrameColor  in TJvXPBarColors.

Contributors(s): matej golob
  //matej 2004-5-3
  --add property BorderColor in TJvXPBarColors.
  --add property HeaderRounded
  --add property TopSpace

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

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvXPBar.pas 11400 2007-06-28 21:24:06Z ahuser $

// Ported to Lazarus (no too hard after all) by Sergio Samayoa - september 2007.
// Still dont tested on linux.

{$mode objfpc}{$H+}

unit JvXPBar;

interface

uses
  ActnList, Classes, Controls, Graphics, ExtCtrls, Forms, ImgList,
  LCLIntf, LCLProc, LCLType, LMessages, LResources, SysUtils,
  JvXPCore, JvXPCoreUtils;

type
  TJvXPBarRollDirection = (rdExpand, rdCollapse);

  TJvXPBarRollMode = (rmFixed, rmShrink); // rmFixed is default

  TJvXPBarHitTest =
   (
    htNone,      // mouse is inside non-supported rect
    htHeader,    // mouse is inside header
    htRollButton // mouse is inside rollbutton
   );

  TJvXPBarRollDelay = 1..200;
  TJvXPBarRollStep = 1..50;

const
  WM_XPBARAFTERCOLLAPSE = WM_USER + 303; // Ord('J') + Ord('V') + Ord('C') + Ord('L')
  WM_XPBARAFTEREXPAND = WM_XPBARAFTERCOLLAPSE + 1;

  { color constants.
  }

//        dxColor_CheckedColorXP :=  TColor($00c9b4e2);
//        dxColor_CheckedColorXP :=  TColor($00d9c1bb);
//        dxColor_CheckedColorXP :=  TColor($00e8ccae);

  dxColor_FocusedColorXP = TColor($00D8ACB0);
  dxColor_CheckedColorXP = TColor($00D9C1BB);
  dxColor_BodyColorXP = TColor($00F7DFD6);
  clHotLight = TColor(COLOR_HOTLIGHT or $80000000);

  dxColor_FocusedFrameColorXP = clHotLight;
  dxColor_CheckedFrameColorXP = clHighlight;

type
  TJvXPBarItem = class;
  TJvXPBarItems = class;
  TJvXPCustomWinXPBar = class;

  TJvXPBarOnCanChangeEvent = procedure(Sender: TObject; Item: TJvXPBarItem;
    var AllowChange: Boolean) of object;

  TJvXPBarOnCollapsedChangeEvent = procedure(Sender: TObject;
    Collapsing: Boolean) of object;

  TJvXPBarOnDrawItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
    Rect: TRect; State: TJvXPDrawState; Item: TJvXPBarItem) of object;
  TJvXPBarOwnerDrawEvent = procedure(Sender: TObject; ACanvas: TCanvas; var ARect: TRect) of object;

  TJvXPBarOnItemClickEvent = procedure(Sender: TObject; Item: TJvXPBarItem) of object;

  TJvXPBarItemActionLink = class(TActionLink)
  private
    FClient: TJvXPBarItem;
  protected
    procedure AssignClient(AClient: TObject); override;
    function IsCaptionLinked: Boolean; override;
    function IsCheckedLinked: 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 SetHint(const Value: string); override;
    function DoShowHint(var HintStr: string): Boolean; virtual;
    function IsAutoCheckLinked: Boolean; virtual;
    procedure SetAutoCheck(Value: Boolean); override;
    procedure SetChecked(Value: Boolean); override;
    procedure SetEnabled(Value: Boolean); override;
    procedure SetImageIndex(Value: Integer); override;
    procedure SetVisible(Value: Boolean); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
    property Client: TJvXPBarItem read FClient write FClient;
  end;

  TJvXPBarItemActionLinkClass = class of TJvXPBarItemActionLink;

  TJvXPBarItemClass = class of TJvXPBarItem;

  TJvXPBarItem = class(TCollectionItem)
  private
    FActionLink: TJvXPBarItemActionLink;
    FCollection: TJvXPBarItems;
    FCaption: TCaption;
    FData: Pointer;
    FDataObject: TObject;
    FEnabled: Boolean;
    FHint: string;
    FImageIndex: TImageIndex;
    FImageList: TCustomImageList;
    FName: string;
    FWinXPBar: TJvXPCustomWinXPBar;
    FTag: Integer;
    FVisible: Boolean;
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FGroupIndex: Integer;
    FChecked: Boolean;
    FAutoCheck: Boolean;
    function IsAutoCheckStored: Boolean;
    function IsCaptionStored: Boolean;
    function IsEnabledStored: Boolean;
    function IsHintStored: Boolean;
    function IsImageIndexStored: Boolean;
    function IsVisibleStored: Boolean;
    function IsOnClickStored: Boolean;
    function IsCheckedStored: Boolean;
    function GetImages: TCustomImageList;
    procedure DoActionChange(Sender: TObject);
    procedure SetAction(Value: TBasicAction);
    procedure SetCaption(Value: TCaption);
    procedure SetEnabled(Value: Boolean);
    procedure SetImageIndex(Value: TImageIndex);
    procedure SetImageList(Value: TCustomImageList);
    procedure SetName(const Value: string);
    procedure SetVisible(Value: Boolean);
    procedure SetGroupIndex(const Value: Integer);
    procedure SetChecked(const Value: Boolean);
    procedure TurnSiblingsOff;
  protected
    function GetActionLinkClass: TJvXPBarItemActionLinkClass; dynamic;
    function GetAction: TBasicAction; virtual;
    function GetDisplayName: string; override;
    procedure Notification(AComponent: TComponent); virtual;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;

    procedure DrawItem(AWinXPBar: TJvXPCustomWinXPBar; ACanvas: TCanvas;
      Rect: TRect; State: TJvXPDrawState; ShowItemFrame: Boolean); virtual;
    property ActionLink: TJvXPBarItemActionLink read FActionLink write FActionLink;
  public
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Data: Pointer read FData write FData;
    property DataObject: TObject read FDataObject write FDataObject;
    property Images: TCustomImageList read GetImages;
    property WinXPBar: TJvXPCustomWinXPBar read FWinXPBar;
  published
    property Action: TBasicAction read GetAction write SetAction;
    property AutoCheck: Boolean read FAutoCheck write FAutoCheck
      stored IsAutoCheckStored default False;
    property Caption: TCaption read FCaption write SetCaption stored IsCaptionStored;
    property Checked: Boolean read FChecked write SetChecked stored IsCheckedStored default False;
    property Enabled: Boolean read FEnabled write SetEnabled stored IsEnabledStored default True;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property Hint: string read FHint write FHint stored IsHintStored;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored default -1;
    property ImageList: TCustomImageList read FImageList write SetImageList;
    property Name: string read FName write SetName;
    property Tag: Integer read FTag write FTag default 0;
    property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True;
    property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  end;

  TJvXPBarItemsClass = class of TJvXPBarItems;

  TJvXPBarItems = class(TCollection)
  private
    FWinXPBar: TJvXPCustomWinXPBar;
    function GetItem(Index: Integer): TJvXPBarItem;
    procedure SetItem(Index: Integer; Value: TJvXPBarItem);
  protected
    procedure Update(Item: TCollectionItem); override;
    function GetOwner: TPersistent; override;
    class function GetItemClass: TJvXPBarItemClass; virtual;
  public
    constructor Create(WinXPBar: TJvXPCustomWinXPBar);
    function Add: TJvXPBarItem; overload;
    function Add(Action: TBasicAction): TJvXPBarItem; overload;
    function Add(DataObject: TObject): TJvXPBarItem; overload;
    function Insert(Index: Integer): TJvXPBarItem; overload;
    function Insert(Index: Integer; Action: TBasicAction): TJvXPBarItem; overload;
    function Insert(Index: Integer; DataObject: TObject): TJvXPBarItem; overload;
    function Find(const AName: string): TJvXPBarItem; overload;
    function Find(const Action: TBasicAction): TJvXPBarItem; overload;
    function Find(const DataObject: TObject): TJvXPBarItem; overload;
    property Items[Index: Integer]: TJvXPBarItem read GetItem write SetItem; default;
  end;

  TJvXPBarVisibleItems = class(TPersistent)
  private
    FItems: TList;
    FWinXPBar: TJvXPCustomWinXPBar;
    function Exists(Item: TJvXPBarItem): Boolean;
    function GetItem(Index: Integer): TJvXPBarItem;
    procedure Add(Item: TJvXPBarItem);
    procedure Delete(Item: TJvXPBarItem);
  public
    constructor Create(WinXPBar: TJvXPCustomWinXPBar);
    destructor Destroy; override;
    function Count: Integer;
    property Items[Index: Integer]: TJvXPBarItem read GetItem; default;
  end;

  TJvXPFadeThread = class(TThread)
  private
    FWinXPBar: TJvXPCustomWinXPBar;
    FRollDirection: TJvXPBarRollDirection;
    FWinXPBarNewOffSet: Integer;
  protected
    procedure DoWinXPBarSetRollOffset;
    procedure DoWinXPBarInternalRedraw;
  public
    constructor Create(WinXPBar: TJvXPCustomWinXPBar; RollDirection: TJvXPBarRollDirection);
    procedure Execute; override;
  end;

  TJvXPBarColors = class(TPersistent)
  private
    FCheckedFrameColor: TColor;
    FFocusedFrameColor: TColor;
    FCheckedColor: TColor;
    FFocusedColor: TColor;
    FBodyColor: TColor;
    FBodyBorderColor: TColor;
    FGradientTo: TColor;
    FGradientFrom: TColor;
    FSeparatorColor: TColor;
    FBorderColor: TColor;
    FOnChange: TNotifyEvent;
    procedure SetBorderColor(const Value: TColor);
    procedure SetBodyColor(const Value: TColor);
    procedure SetGradientFrom(const Value: TColor);
    procedure SetGradientTo(const Value: TColor);
    procedure SetSeparatorColor(const Value: TColor);
    procedure SetCheckedColor(const Value: TColor);
    procedure SetFocusedColor(const Value: TColor);
    procedure SetCheckedFrameColor(const Value: TColor);
    procedure SetFocusedFrameColor(const Value: TColor);
    procedure SetBodyBorderColor(const Value: TColor);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure Change;
  published
    property BorderColor: TColor read FBorderColor write SetBorderColor  default clWhite;
    property CheckedColor: TColor read FCheckedColor write SetCheckedColor default dxColor_CheckedColorXP;
    property FocusedColor: TColor read FFocusedColor write SetFocusedColor default dxColor_FocusedColorXP;
    property CheckedFrameColor: TColor read FCheckedFrameColor write SetCheckedFrameColor
      default dxColor_CheckedFrameColorXP;
    property FocusedFrameColor: TColor read FFocusedFrameColor write SetFocusedFrameColor
      default dxColor_FocusedFrameColorXP;
    property BodyColor: TColor read FBodyColor write SetBodyColor default dxColor_BodyColorXP;
    property BodyBorderColor: TColor read FBodyBorderColor write SetBodyBorderColor default dxColor_BodyColorXP;
    property GradientFrom: TColor read FGradientFrom write SetGradientFrom default clWhite;
    property GradientTo: TColor read FGradientTo write SetGradientTo default TColor($00F7D7C6);
    property SeparatorColor: TColor read FSeparatorColor write SetSeparatorColor default TColor($00F7D7C6);
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TJvXPBarOptions = class(TPersistent)
  end;

  TJvXPCustomWinXPBar = class(TJvXPCustomControl)
  private
    FCollapsed: Boolean;
    FFadeThread: TJvXPFadeThread;
    FFont: TFont;
    FFontChanging: Boolean;
    FGradientWidth: Integer;
    FHeaderFont: TFont;
    FHeaderRounded: Boolean;
    FHitTest: TJvXPBarHitTest;
    FHotTrack: Boolean;
    FHoverIndex: Integer;
    FIcon: TIcon;
    FImageList: TCustomImageList;
    FItemHeight: Integer;
    FItems: TJvXPBarItems;
    FRollDelay: TJvXPBarRollDelay;
    FRolling: Boolean;
    FRollMode: TJvXPBarRollMode;
    FRollOffset: Integer;
    FRollStep: TJvXPBarRollStep;
    FShowLinkCursor: Boolean;
    FShowRollButton: Boolean;
    FHotTrackColor: TColor;
    FVisibleItems: TJvXPBarVisibleItems;
    FAfterCollapsedChange: TJvXPBarOnCollapsedChangeEvent;
    FBeforeCollapsedChange: TJvXPBarOnCollapsedChangeEvent;
    FOnCollapsedChange: TJvXPBarOnCollapsedChangeEvent;
    FOnCanChange: TJvXPBarOnCanChangeEvent;
    FOnDrawItem: TJvXPBarOnDrawItemEvent;
    FOnItemClick: TJvXPBarOnItemClickEvent;
    FColors: TJvXPBarColors;
    FRollImages: TCustomImageList;
    FImageChangeLink: TChangeLink;
    FRollChangeLink: TChangeLink;
    FGrouped: Boolean;
    FHeaderHeight: Integer;
    FStoredHint: string;
    FShowItemFrame: Boolean;
    FRoundedItemFrame: Integer;  // DS
    FTopSpace: Integer;
    FOwnerDraw: Boolean;
    FOnDrawBackground: TJvXPBarOwnerDrawEvent;
    FOnDrawHeader: TJvXPBarOwnerDrawEvent;
    procedure FontChange(Sender: TObject);
    procedure SetCollapsed(Value: Boolean);
    procedure SetFont(Value: TFont);
    procedure SetHeaderFont(Value: TFont);
    procedure SetHotTrack(Value: Boolean);
    procedure SetHotTrackColor(Value: TColor);
    procedure SetIcon(Value: TIcon);
    procedure SetImageList(Value: TCustomImageList);
    procedure SetItemHeight(Value: Integer);
    procedure SetItems(Value: TJvXPBarItems);
    procedure SetRollOffset(const Value: Integer);
    procedure SetShowRollButton(Value: Boolean);
    procedure ResizeToMaxHeight;
    procedure SetColors(const Value: TJvXPBarColors);
    procedure SetRollImages(const Value: TCustomImageList);
    procedure SetGrouped(const Value: Boolean);
    procedure GroupMessage;
    procedure SetHeaderHeight(const Value: Integer);
    function GetRollHeight: Integer;
    function GetRollWidth: Integer;
    procedure SetHeaderRounded(const Value: Boolean);
    procedure SetTopSpace(const Value: Integer);
    procedure SetOwnerDraw(const Value: Boolean);
  protected
    procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
    class function GetBarItemsClass: TJvXPBarItemsClass; virtual;
    function GetHitTestRect(const AHitTest: TJvXPBarHitTest): TRect;
    function GetItemRect(Index: Integer): TRect; virtual;
    procedure ItemVisibilityChanged(Item: TJvXPBarItem); dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure HookMouseDown; override;
    procedure HookMouseEnter; override;
    procedure HookMouseLeave; override;
    procedure HookMouseMove(X: Integer = 0; Y: Integer = 0); override;
    procedure HookParentFontChanged; override;
    procedure HookResized; override;
    procedure SortVisibleItems(const Redraw: Boolean);
    procedure DoColorsChange(Sender: TObject);
    procedure DoDrawItem(const Index: Integer; State: TJvXPDrawState); virtual;
    procedure Paint; override;
    procedure EndUpdate; override;
    procedure WMAfterXPBarCollapse(var Msg: TLMessage); message WM_XPBARAFTERCOLLAPSE;
    procedure WMAfterXPBarExpand(var Msg: TLMessage); message WM_XPBARAFTEREXPAND;
    property Collapsed: Boolean read FCollapsed write SetCollapsed default False;
    property Colors: TJvXPBarColors read FColors write SetColors;
    property RollImages: TCustomImageList read FRollImages write SetRollImages;
    property Font: TFont read FFont write SetFont;
    property Grouped: Boolean read FGrouped write SetGrouped default False;
    property HeaderFont: TFont read FHeaderFont write SetHeaderFont stored;
    property HeaderHeight: Integer read FHeaderHeight write SetHeaderHeight default 28;
    property HeaderRounded: Boolean read FHeaderRounded write SetHeaderRounded default True;
    property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw;
    property HotTrack: Boolean read FHotTrack write SetHotTrack default True;
    property HotTrackColor: TColor read FHotTrackColor write SetHotTrackColor default $00FF7C35;
    property Icon: TIcon read FIcon write SetIcon;
    property ImageList: TCustomImageList read FImageList write SetImageList;
    property ItemHeight: Integer read FItemHeight write SetItemHeight default 20;
    property Items: TJvXPBarItems read FItems write SetItems;
    property RollDelay: TJvXPBarRollDelay read FRollDelay write FRollDelay default 25;
    property Rolling: Boolean read FRolling default False;
    property RollMode: TJvXPBarRollMode read FRollMode write FRollMode default rmShrink;
    property RollOffset: Integer read FRollOffset write SetRollOffset;
    property RollStep: TJvXPBarRollStep read FRollStep write FRollStep default 3;
    property ShowLinkCursor: Boolean read FShowLinkCursor write FShowLinkCursor default True;
    property ShowRollButton: Boolean read FShowRollButton write SetShowRollButton default True;
    property ShowItemFrame: Boolean read FShowItemFrame write FShowItemFrame;
    property RoundedItemFrame: Integer read FRoundedItemFrame write FRoundedItemFrame default 1; //DS
    property TopSpace: Integer read FTopSpace write SetTopSpace default 5;
    property AfterCollapsedChange: TJvXPBarOnCollapsedChangeEvent read FAfterCollapsedChange
      write FAfterCollapsedChange;
    property BeforeCollapsedChange: TJvXPBarOnCollapsedChangeEvent read FBeforeCollapsedChange
      write FBeforeCollapsedChange;
    property OnCollapsedChange: TJvXPBarOnCollapsedChangeEvent read FOnCollapsedChange write FOnCollapsedChange;
    property OnCanChange: TJvXPBarOnCanChangeEvent read FOnCanChange write FOnCanChange;
    property OnDrawItem: TJvXPBarOnDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnDrawBackground: TJvXPBarOwnerDrawEvent read FOnDrawBackground write FOnDrawBackground;
    property OnDrawHeader: TJvXPBarOwnerDrawEvent read FOnDrawHeader write FOnDrawHeader;
    property OnItemClick: TJvXPBarOnItemClickEvent read FOnItemClick write FOnItemClick;
    procedure AdjustClientRect(var Rect: TRect); override;
    // show hints for individual items in the list
    function HintShow(var HintInfo: THintInfo): Boolean;
      {$IFDEF USEJVCL} override; {$ELSE} dynamic; {$ENDIF}
    {$IFNDEF USEJVCL}
    procedure CMHintShow(var Msg: TCMHintShow); message CM_HINTSHOW;
    {$ENDIF !USEJVCL}
    procedure DblClick; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetHitTestAt(X, Y: Integer): TJvXPBarHitTest;
    function GetItemAt(X, Y: Integer): Integer;
    procedure Click; override;
    property Height default 46;
    property VisibleItems: TJvXPBarVisibleItems read FVisibleItems;
    property Width default 153;
    procedure InitiateAction; override;
  end;

  TJvXPBar = class(TJvXPCustomWinXPBar)
  published
    property Caption;
    property Collapsed;
    property Colors;
    property Items;
    property RollImages;
    property Font;
    property Grouped;
    property HeaderFont;
    property HeaderHeight;
    property HeaderRounded;
    property HotTrack;
    property HotTrackColor;
    property OwnerDraw;
    property Icon;
    property ImageList;
    property ItemHeight;
    property RollDelay;
    property RollMode;
    property RollStep;
    property ShowLinkCursor;
    property ShowRollButton;
    property ShowItemFrame;
    property RoundedItemFrame;
    property TopSpace;

    property AfterCollapsedChange;
    property BeforeCollapsedChange;
    property OnCollapsedChange;
    property OnCanChange;
    property OnDrawItem;
    property OnDrawBackground;
    property OnDrawHeader;
    property OnItemClick;

    //property BevelInner;
    //property BevelOuter;
    //property BevelWidth;
    //property BiDiMode;
    //property Ctl3D;
    //property DockSite;
    //property ParentBiDiMode;
    //property ParentCtl3D;
    //property TabOrder;
    //property TabStop;
    //property UseDockManager default True;
    property Align;
    property Anchors;
    //property AutoSize;
    property BorderSpacing;
    property Constraints;
    property DragCursor;
    property DragKind;
    //21.09.07 - SESS
    //property OnCanResize;
    property DragMode;
    //property Enabled;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    //property OnDockDrop;
    //property OnDockOver;
    //property OnEndDock;
    //property OnGetSiteInfo;
    //property OnStartDock;
    //property OnUnDock;
    property OnClick;
    property OnDblClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

procedure RoundedFrame(Canvas: TCanvas; ARect: TRect; AColor: TColor; R: Integer);

implementation

uses
  Menus;

resourcestring
  RsUntitled = 'untitled';
  RsUntitledFmt = '(%s %d)';
  RsHintShortcutFmt = '%s (%s)';

const
  FC_HEADER_MARGIN = 6;
  FC_ITEM_MARGIN = 8;

function SortByIndex(Item1, Item2: Pointer): Integer;
var
  Idx1, Idx2: Integer;
begin
  Idx1 := TCollectionItem(Item1).Index;
  Idx2 := TCollectionItem(Item2).Index;
  if Idx1 < Idx2 then
    Result := -1
  else
  if Idx1 = Idx2 then
    Result := 0
  else
    Result := 1;
end;

//=== { TJvXPBarItemActionLink } =============================================

procedure TJvXPBarItemActionLink.AssignClient(AClient: TObject);
begin
  Client := AClient as TJvXPBarItem;
end;


function TJvXPBarItemActionLink.IsAutoCheckLinked: Boolean;
begin
  Result := (Client.AutoCheck = (Action as TCustomAction).AutoCheck);
end;

function TJvXPBarItemActionLink.IsCaptionLinked: Boolean;
begin
  Result := inherited IsCaptionLinked and
    (Client.Caption = (Action as TCustomAction).Caption);
end;

function TJvXPBarItemActionLink.IsCheckedLinked: Boolean;
begin
  Result := inherited IsCheckedLinked and
    (Client.Checked = (Action as TCustomAction).Checked);
end;

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

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

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

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

function TJvXPBarItemActionLink.IsOnExecuteLinked: Boolean;
begin
  Result := inherited IsOnExecuteLinked and
    JvXPMethodsEqual(TMethod(Client.OnClick), TMethod(Action.OnExecute));
end;

procedure TJvXPBarItemActionLink.SetAutoCheck(Value: Boolean);
begin
  if IsAutoCheckLinked then
    Client.AutoCheck := Value;
end;

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

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

procedure TJvXPBarItemActionLink.SetChecked(Value: Boolean);
begin
  if IsCheckedLinked then
    Client.Checked := Value;
end;


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

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

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

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

//===TJvXPBarItem ============================================================

constructor TJvXPBarItem.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);
  FCollection := TJvXPBarItems(ACollection);
  FCaption := '';
  FData := nil;
  FDataObject := nil;
  FEnabled := True;
  FImageIndex := -1;
  FImageList := nil;
  FHint := '';
  FName := '';
  FWinXPBar := FCollection.FWinXPBar;
  FTag := 0;
  FVisible := True;
  FAutoCheck := False;
  FChecked := False;
  FGroupIndex := 0;
  FWinXPBar.ItemVisibilityChanged(Self);
  FWinXPBar.ResizeToMaxHeight;
end;

destructor TJvXPBarItem.Destroy;
begin
  FVisible := False; // required to remove from visible list!
  FWinXPBar.ItemVisibilityChanged(Self);
  FActionLink.Free;
  FActionLink := nil;

  inherited Destroy;
  FWinXPBar.ResizeToMaxHeight;
end;

procedure TJvXPBarItem.Notification(AComponent: TComponent);
begin
  if AComponent = Action then
    Action := nil;
  if AComponent = FImageList then
    FImageList := nil;
end;

function TJvXPBarItem.GetDisplayName: string;
begin
  Result := FCaption;
  if Result = '' then
    Result := RsUntitled;  
  if FName <> '' then
    Result := Result + ' [' + FName + ']';
  if not FVisible then
    Result := Result + '*';
end;

function TJvXPBarItem.GetImages: TCustomImageList;
begin
  Result := nil;
  if Assigned(FImageList) then
    Result := FImageList
  else
  if Assigned(Action) and Assigned(TAction(Action).ActionList.Images) then
    Result := TAction(Action).ActionList.Images
  else
  if Assigned(FWinXPBar.FImageList) then
    Result := FWinXPBar.FImageList;
end;

procedure TJvXPBarItem.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not (csLoading in ComponentState) then
        Update;
      if not CheckDefaults or not Self.AutoCheck then
        Self.AutoCheck := AutoCheck;
      if not CheckDefaults or (Self.Caption = '') or (Self.Caption = Self.Name) then
        Self.Caption := Caption;
      if not CheckDefaults or not Self.Checked then
        Self.Checked := Checked;
      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 TJvXPBarItem.DrawItem(AWinXPBar: TJvXPCustomWinXPBar; ACanvas: TCanvas;
  Rect: TRect; State: TJvXPDrawState; ShowItemFrame: Boolean);
var
  ItemCaption: TCaption;
  WorkImages: TCustomImageList;
  LBar: TJvXPCustomWinXPBar;
begin
  LBar := (AWinXPBar as TJvXPCustomWinXPBar);
  with ACanvas do
  begin
    Font.Assign(LBar.Font);
    Brush.Color := LBar.Colors.BodyColor;
    if not ShowItemFrame then
      FillRect(Rect);
    if not Self.Enabled then
      Font.Color := clGray
    else
    begin
      if dsFocused in State then
      begin
        if LBar.HotTrack then
        begin
          if LBar.FHotTrackColor <> clNone then
            Font.Color := LBar.FHotTrackColor;
          Font.Style := Font.Style + [fsUnderline];
        end;
        if ShowItemFrame then
        begin
          Brush.Color := LBar.Colors.FocusedColor;
          if LBar.RoundedItemFrame > 0 then
            RoundedFrame(ACanvas, Rect, LBar.Colors.FocusedFrameColor, LBar.RoundedItemFrame)
          else
          begin
            FillRect(Rect);
            JvXPFrame3D(ACanvas, Rect, LBar.Colors.FocusedFrameColor, LBar.Colors.FocusedFrameColor);
          end;
        end;
      end
      else
      if dsClicked in State then
      begin
        if ShowItemFrame then
        begin
          Brush.Color := LBar.Colors.CheckedColor;
          if LBar.RoundedItemFrame > 0 then
            RoundedFrame(ACanvas, Rect, LBar.Colors.CheckedFrameColor, LBar.RoundedItemFrame)
          else
          begin
            FillRect(Rect);
            JvXPFrame3D(ACanvas, Rect, LBar.Colors.CheckedFrameColor, LBar.Colors.CheckedFrameColor);
          end;
        end;
      end
      else
        FillRect(Rect);
    end;
    WorkImages := Self.Images;
    if WorkImages <> nil then
    begin
      if (Self.ImageIndex <> -1) then
         WorkImages.Draw(ACanvas, Rect.Left + 1,
           Rect.Top + (LBar.FItemHeight - WorkImages.Height) div 2, Self.ImageIndex);
      Inc(Rect.Left, Self.Images.Width + 4);
    end
    else
      Inc(Rect.Left, 4);
    ItemCaption := Self.Caption;
    if (ItemCaption = '') and ((csDesigning in LBar.ComponentState) or (LBar.ControlCount = 0)) then
      ItemCaption := Format(RsUntitledFmt, [RsUntitled, Index]);
    SetBkMode(ACanvas.Handle, TRANSPARENT);
    //{$IFDEF USEJVCL}
    //DrawText(ACanvas, ItemCaption, -1, Rect,
    //  DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);
    //{$ELSE}
    DrawText(ACanvas.Handle, PAnsiChar(ItemCaption), Length(ItemCaption), Rect,
      DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);
  end;
end;

function TJvXPBarItem.GetActionLinkClass: TJvXPBarItemActionLinkClass;
begin
  Result := TJvXPBarItemActionLink;
end;

procedure TJvXPBarItem.Assign(Source: TPersistent);
begin
  if Source is TJvXPBarItem then
    with TJvXPBarItem(Source) do
    begin
      Self.Action := Action;
      Self.Caption := Caption;
      Self.Data := Data;
      Self.DataObject := DataObject;
      Self.Enabled := Enabled;
      Self.Hint := Hint;
      Self.ImageList := ImageList;
      Self.ImageIndex := ImageIndex;
      Self.Name := Name;
      Self.Tag := Tag;
      Self.Visible := Visible;
      Self.OnClick := OnClick;
      Self.AutoCheck := AutoCheck;
      Self.Checked := Checked;
      Self.GroupIndex := GroupIndex;
      Self.OnDblClick := OnDblClick;
    end
  else
    inherited Assign(Source);
end;

function TJvXPBarItem.IsAutoCheckStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsAutoCheckLinked;
end;

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

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

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

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

function TJvXPBarItem.IsVisibleStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsVisibleLinked;
end;

function TJvXPBarItem.IsOnClickStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsOnExecuteLinked;
end;

function TJvXPBarItem.IsCheckedStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsCheckedLinked;
end;

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

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

procedure TJvXPBarItem.SetAction(Value: TBasicAction);
begin
  if Value = nil then
  begin
    FActionLink.Free;
    FActionLink := nil;
    FWinXPBar.InternalRedraw; // redraw image
  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(FWinXPBar); // deligates notification to WinXPBar!
  end;
end;

procedure TJvXPBarItem.SetCaption(Value: TCaption);
begin
  if Value <> FCaption then
  begin
    FCaption := Value;
    FWinXPBar.InternalRedraw;
  end;
end;

procedure TJvXPBarItem.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    FWinXPBar.InternalRedraw;
  end;
end;

procedure TJvXPBarItem.SetImageIndex(Value: TImageIndex);
begin
  if Value <> FImageIndex then
  begin
    FImageIndex := Value;
    FWinXPBar.InternalRedraw;
  end;
end;

procedure TJvXPBarItem.SetImageList(Value: TCustomImageList);
begin
  if Value <> FImageList then
  begin
    FImageList := Value;
    FWinXPBar.InternalRedraw;
  end;
end;

procedure TJvXPBarItem.SetName(const Value: string);
begin
  if (Value <> FName) and (FCollection.Find(Value) = nil) then
    FName := Value;
end;

procedure TJvXPBarItem.SetVisible(Value: Boolean);
begin
  if Value <> FVisible then
  begin
    FVisible := Value;
    FWinXPBar.ItemVisibilityChanged(Self);
    FWinXPBar.ResizeToMaxHeight;
  end;
end;

procedure TJvXPBarItem.SetGroupIndex(const Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    if Checked then
      TurnSiblingsOff;
  end;
end;

procedure TJvXPBarItem.SetChecked(const Value: Boolean);
begin
  if FChecked <> Value then
  begin
    FChecked := Value;
//    Change(False);
    if Value then
      TurnSiblingsOff;
  end;
end;

procedure TJvXPBarItem.TurnSiblingsOff;
var
  I: Integer;
  Item: TJvXPBarItem;
begin
  if (GroupIndex <> 0) and Assigned(FWinXPBar) then
  begin
    for I := 0 to FWinXPBar.Items.Count - 1 do
    begin
      Item := FWinXPBar.Items[I];
      if (Item <> Self) and (Item.GroupIndex = GroupIndex) then
        Item.Checked := False;
    end;
  end;
end;

//=== { TJvXPBarItems } ======================================================

constructor TJvXPBarItems.Create(WinXPBar: TJvXPCustomWinXPBar);
begin
  inherited Create(GetItemClass);
  FWinXPBar := WinXPBar;
end;

function TJvXPBarItems.Add: TJvXPBarItem;
begin
  Result := TJvXPBarItem(inherited Add);
end;

function TJvXPBarItems.Add(Action: TBasicAction): TJvXPBarItem;
begin
  Result := Add;
  Result.Action := Action;
end;

function TJvXPBarItems.Add(DataObject: TObject): TJvXPBarItem;
begin
  Result := Add;
  Result.DataObject := DataObject;
end;

function TJvXPBarItems.Insert(Index: Integer): TJvXPBarItem;
begin
  Result := TJvXPBarItem(inherited Insert(Index));
end;

function TJvXPBarItems.Insert(Index: Integer; Action: TBasicAction): TJvXPBarItem;
begin
  Result := Insert(Index);
  Result.Action := Action;
end;

function TJvXPBarItems.Insert(Index: Integer; DataObject: TObject): TJvXPBarItem;
begin
  Result := Insert(Index);
  Result.DataObject := DataObject;
end;

function TJvXPBarItems.GetOwner: TPersistent;
begin
  Result := FWinXPBar;
end;

class function TJvXPBarItems.GetItemClass: TJvXPBarItemClass;
begin
  Result := TJvXPBarItem;
end;

function TJvXPBarItems.GetItem(Index: Integer): TJvXPBarItem;
begin
  Result := TJvXPBarItem(inherited GetItem(Index));
end;

procedure TJvXPBarItems.SetItem(Index: Integer; Value: TJvXPBarItem);
begin
  inherited SetItem(Index, Value);
end;

procedure TJvXPBarItems.Update(Item: TCollectionItem);
begin
  FWinXPBar.SortVisibleItems(True);
end;

function TJvXPBarItems.Find(const AName: string): TJvXPBarItem;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].Name = AName then
    begin
      Result := Items[I];
      Break;
    end;
end;

function TJvXPBarItems.Find(const Action: TBasicAction): TJvXPBarItem;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].Action = Action then
    begin
      Result := Items[I];
      Break;
    end;
end;

function TJvXPBarItems.Find(const DataObject: TObject): TJvXPBarItem;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].DataObject = DataObject then
    begin
      Result := Items[I];
      Break;
    end;
end;

//=== { TJvXPBarVisibleItems } ===============================================

constructor TJvXPBarVisibleItems.Create(WinXPBar: TJvXPCustomWinXPBar);
begin
  inherited Create;
  FItems := TList.Create;
  FWinXPBar := WinXPBar;
end;

destructor TJvXPBarVisibleItems.Destroy;
begin
  FItems.Free;
  inherited Destroy;
end;

function TJvXPBarVisibleItems.GetItem(Index: Integer): TJvXPBarItem;
begin
  Result := nil;
  if Index < FItems.Count then
    Result := TJvXPBarItem(FItems[Index]);
end;

function TJvXPBarVisibleItems.Count: Integer;
begin
  Result := FItems.Count;
end;

function TJvXPBarVisibleItems.Exists(Item: TJvXPBarItem): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to Count - 1 do
    if Items[I] = Item then
    begin
      Result := True;
      Break;
    end;
end;

procedure TJvXPBarVisibleItems.Add(Item: TJvXPBarItem);
begin
  if not Exists(Item) then
  begin
    FItems.Add(Item);
    FWinXPBar.SortVisibleItems(False);
  end;
end;

procedure TJvXPBarVisibleItems.Delete(Item: TJvXPBarItem);
begin
  if Exists(Item) then
    FItems.Delete(FItems.IndexOf(Item));
end;

//=== { TJvXPFadeThread } ====================================================

constructor TJvXPFadeThread.Create(WinXPBar: TJvXPCustomWinXPBar;
  RollDirection: TJvXPBarRollDirection);
begin
  inherited Create(True);
  FWinXPBar := WinXPBar;
  FRollDirection := RollDirection;
  FreeOnTerminate := True;
  Suspended := False;
end;

procedure TJvXPFadeThread.DoWinXPBarInternalRedraw;
begin
  FWinXPBar.InternalRedraw;
end;

procedure TJvXPFadeThread.DoWinXPBarSetRollOffset;
begin
  FWinXPBar.RollOffset := FWinXPBarNewOffSet;
end;

procedure TJvXPFadeThread.Execute;
var
  NewOffset: Integer;
begin
  while not Terminated do
  try
    FWinXPBar.FRolling := True;

    { calculate new roll offset }
    if FRollDirection = rdCollapse then
      NewOffset := FWinXPBar.RollOffset - FWinXPBar.FRollStep
    else
      NewOffset := FWinXPBar.RollOffset + FWinXPBar.FRollStep;

    { validate offset ranges }
    if NewOffset < 0 then
      NewOffset := 0;
    if NewOffset > FWinXPBar.FItemHeight then
      NewOffset := FWinXPBar.FItemHeight;

    FWinXPBarNewOffSet := NewOffset;

    Synchronize(@DoWinXPBarSetRollOffset);

    { terminate on 'out-of-range' }
    if ((FRollDirection = rdCollapse) and (NewOffset = 0)) or
      ((FRollDirection = rdExpand) and (NewOffset = FWinXPBar.FItemHeight)) then
      Terminate;

    { idle process }
    Sleep(FWinXPBar.FRollDelay);
  finally
    FWinXPBar.FRolling := False;
  end;

  { redraw button state }
  FWinXPBar.FCollapsed := FRollDirection = rdCollapse;
  if FWinXPBar.FShowRollButton then
    Synchronize(@DoWinXPBarInternalRedraw);

  { update inspector }
  if csDesigning in FWinXPBar.ComponentState then
    TCustomForm(FWinXPBar.Owner).Designer.Modified
  else
    PostMessage(FWinXPBar.Handle, WM_XPBARAFTERCOLLAPSE,
      Ord(FRollDirection = rdCollapse), 0);
end;

//=== { TJvXPBarColors } =====================================================

constructor TJvXPBarColors.Create;
begin
  inherited Create;
  // (rom) needs local color constants
  FBodyColor := dxColor_BodyColorXP;
  FBodyBorderColor := dxColor_BodyColorXP;
  FBorderColor := clWhite;
  FGradientFrom := clWhite;
  FGradientTo := TColor($00F7D7C6);
  FSeparatorColor := TColor($00F7D7C6);
  FCheckedColor := dxColor_CheckedColorXP;
  FFocusedColor := dxColor_FocusedColorXP;
  FCheckedFrameColor := dxColor_CheckedFrameColorXP;
  FFocusedFrameColor := dxColor_FocusedFrameColorXP;
end;

procedure TJvXPBarColors.Assign(Source: TPersistent);
begin
  if Source is TJvXPBarColors then
    with TJvXPBarColors(Source) do
    begin
      Self.CheckedColor := CheckedColor;
      Self.FocusedColor := FocusedColor;
      Self.CheckedFrameColor := CheckedFrameColor;
      Self.FocusedFrameColor := FocusedFrameColor;
      Self.BodyColor := BodyColor;
      Self.GradientTo := GradientTo;
      Self.GradientFrom := GradientFrom;
      Self.SeparatorColor := SeparatorColor;
    end
  else
    inherited Assign(Source);
end;

procedure TJvXPBarColors.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvXPBarColors.SetBodyColor(const Value: TColor);
begin
  if FBodyColor <> Value then
  begin
    FBodyColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetGradientFrom(const Value: TColor);
begin
  if FGradientFrom <> Value then
  begin
    FGradientFrom := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetGradientTo(const Value: TColor);
begin
  if FGradientTo <> Value then
  begin
    FGradientTo := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetSeparatorColor(const Value: TColor);
begin
  if FSeparatorColor <> Value then
  begin
    FSeparatorColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetCheckedColor(const Value: TColor);
begin
  if FCheckedColor <> Value then
  begin
    FCheckedColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetBorderColor(const Value: TColor);
begin
  if FBorderColor <> Value then
  begin
    FBorderColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetFocusedColor(const Value: TColor);
begin
  if FFocusedColor <> Value then
  begin
    FFocusedColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetCheckedFrameColor(const Value: TColor);
begin
  if FCheckedFrameColor <> Value then
  begin
    FCheckedFrameColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetFocusedFrameColor(const Value: TColor);
begin
  if FFocusedFrameColor <> Value then
  begin
    FFocusedFrameColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetBodyBorderColor(const Value: TColor);
begin
  if FBodyBorderColor <> Value then
  begin
    FBodyBorderColor := Value;
    Change;
  end;
end;

//=== { TJvXPCustomWinXPBar } ================================================

constructor TJvXPCustomWinXPBar.Create(AOwner: TComponent);
const
  MouseEvents: TJvXPControlStyle = [csRedrawMouseEnter, csRedrawMouseLeave];
begin
  inherited Create(AOwner);
  FStoredHint := '|'; // no one in their right mind uses a pipe as the only character in a hint...
  ControlStyle := ControlStyle {- [csDoubleClicks]} + [csAcceptsControls, csActionClient];
  ExControlStyle := [csRedrawCaptionChanged];
  ExControlStyle := ExControlStyle + MouseEvents;
  Height := 46;
  HotTrack := True; // initialize mouse events
  Width := 153;
  FColors := TJvXPBarColors.Create;
  FColors.OnChange := @DoColorsChange;
  FCollapsed := False;
  FFadeThread := nil;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := @DoColorsChange;
  FRollChangeLink := TChangeLink.Create;
  FRollChangeLink.OnChange := @DoColorsChange;
  FTopSpace := 5;

  FFont := TFont.Create;
  FFont.Color := $00840000;
  FFont.Size := 8;
  FFont.OnChange := @FontChange;
  FHeaderHeight := 28;
  FHeaderRounded := True;
  FGradientWidth := 0;
  FHeaderFont := TFont.Create;
  FHeaderFont.Color := $00840000;
  FHeaderFont.Size := 8;
  FHeaderFont.Style := [fsBold];
  FHeaderFont.OnChange := @FontChange;

  FHitTest := htNone;

  FHotTrackColor := $00FF7C35;
  FHoverIndex := -1;
  FIcon := TIcon.Create;
  FItemHeight := 20;
  FItems := GetBarItemsClass.Create(Self);
  FRollDelay := 25;
  FRolling := False;
  FRollMode := rmShrink;
  FRollOffset := FItemHeight;
  FRollStep := 3;
  FShowLinkCursor := True;
  FShowRollButton := True;
  FVisibleItems := TJvXPBarVisibleItems.Create(Self);
end;

destructor TJvXPCustomWinXPBar.Destroy;
begin
  FFont.Free;
  FHeaderFont.Free;
  FIcon.Free;
  FItems.Free;
  FVisibleItems.Free;
  FColors.Free;
  FImageChangeLink.Free;
  FRollChangeLink.Free;
  inherited Destroy;
end;

procedure TJvXPCustomWinXPBar.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I: Integer;
begin
  if not (csDestroying in ComponentState) and (Operation = opRemove) then
  begin
    if AComponent = FImageList then
      ImageList := nil;
    if AComponent = FRollImages then
      RollImages := nil;
    for I := 0 to FItems.Count - 1 do
      FItems[I].Notification(AComponent);
  end;
  inherited Notification(AComponent, Operation);
end;

procedure TJvXPCustomWinXPBar.FontChange(Sender: TObject);
begin
  if (not FFontChanging) and not (csLoading in ComponentState) then
    ParentFont := False;
  InternalRedraw;
end;

procedure TJvXPCustomWinXPBar.ResizeToMaxHeight;
var
  NewHeight: Integer;
begin
  { TODO: Check this!!! }
  if IsLocked then
    Exit;
  NewHeight := FC_HEADER_MARGIN + HeaderHeight + FVisibleItems.Count * FRollOffset + FC_ITEM_MARGIN + 1;
  { full collapsing }
  if ((FRolling and not FCollapsed) or (not FRolling and FCollapsed) or
    (FVisibleItems.Count = 0)) then
    Dec(NewHeight, FC_ITEM_MARGIN);
//  if Height <> NewHeight then
  Height := NewHeight - 5 + FTopSpace;
end;

function TJvXPCustomWinXPBar.GetHitTestAt(X, Y: Integer): TJvXPBarHitTest;
begin
  Result := htNone;
  if PtInRect(GetHitTestRect(htHeader), Point(X, Y)) then
    Result := htHeader;
  if PtInRect(GetHitTestRect(htRollButton), Point(X, Y)) then
    Result := htRollButton;
end;

function TJvXPCustomWinXPBar.GetItemRect(Index: Integer): TRect;
begin
  Result.Left := 3;
  Result.Right := Width - 3;
  if FRollMode = rmShrink then
    Result.Top := FC_HEADER_MARGIN + HeaderHeight + FC_ITEM_MARGIN div 2 +
      Index * FRollOffset - 4 + FTopSpace
  else
    Result.Top := FC_HEADER_MARGIN + HeaderHeight + FC_ITEM_MARGIN div 2 +
      Index * FItemHeight - 4 + FTopSpace;
  Result.Bottom := Result.Top + FItemHeight;
end;

function TJvXPCustomWinXPBar.GetRollHeight: Integer;
begin
  if Assigned(FRollImages) then
    Result := FRollImages.Height
  else
    Result := 18;
end;

function TJvXPCustomWinXPBar.GetRollWidth: Integer;
begin
  if Assigned(FRollImages) then
    Result := FRollImages.Width
  else
    Result := 18;
end;

function TJvXPCustomWinXPBar.GetHitTestRect(const AHitTest: TJvXPBarHitTest): TRect;

begin
  case AHitTest of
    htHeader:
      Result := Bounds(0, FTopSpace, Width, FHeaderHeight);
    htRollButton:
      Result := Bounds(Width - 24, FTopSpace + (FHeaderHeight - GetRollHeight) div 2, GetRollWidth, GetRollHeight);
  end;
end;

procedure TJvXPCustomWinXPBar.SortVisibleItems(const Redraw: Boolean);
begin
  if (csLoading in ComponentState) or (csDestroying in ComponentState) then
    Exit;
  FVisibleItems.FItems.Sort(@SortByIndex);
  if Redraw then
    InternalRedraw;
end;

procedure TJvXPCustomWinXPBar.ItemVisibilityChanged(Item: TJvXPBarItem);
begin
  // update visible-item list
  if Item.Visible then
    FVisibleItems.Add(Item)
  else
    FVisibleItems.Delete(Item);
end;

procedure TJvXPCustomWinXPBar.HookMouseDown;
var
  Rect: TRect;
begin
  inherited HookMouseDown; // update drawstate
  if FHitTest = htRollButton then
  begin
    Rect := GetHitTestRect(htRollButton);
    InvalidateRect(Handle, @Rect, False);
  end;
end;

procedure TJvXPCustomWinXPBar.HookMouseEnter;
begin
  inherited HookMouseEnter;
  if FHoverIndex <> -1 then
    DoDrawItem(FHoverIndex, [dsFocused]);
end;

procedure TJvXPCustomWinXPBar.HookMouseLeave;
begin
  inherited HookMouseLeave;
  if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and
    (not FVisibleItems[FHoverIndex].Checked) then
    DoDrawItem(FHoverIndex, []);
end;


function TJvXPCustomWinXPBar.GetItemAt(X, Y: Integer): Integer;
var
  Header: Integer;
begin
  Header := FC_HEADER_MARGIN div 2 + HeaderHeight + FC_ITEM_MARGIN div 2 + FTopSpace;
  if (Y < Header) or (Y > Height - FC_ITEM_MARGIN div 2) then
    Result := -1
  else
    Result := (Y - Header) div ItemHeight;
end;

procedure TJvXPCustomWinXPBar.HookMouseMove(X, Y: Integer);
const
  cPipe = '|';
var
  Rect: TRect;
  OldHitTest: TJvXPBarHitTest;
  NewIndex: Integer;
begin
  OldHitTest := FHitTest;
  FHitTest := GetHitTestAt(X, Y);
  if FHitTest <> OldHitTest then
  begin
    Rect := Bounds(0, FTopSpace, Width, FHeaderHeight); // header
    InvalidateRect(Handle, @Rect, False);
    if FShowLinkCursor then
      if FHitTest <> htNone then
        Cursor := crHandPoint
      else
        Cursor := crDefault;
  end;

  NewIndex := GetItemAt(X, Y);

  if (NewIndex >= 0) and (NewIndex < VisibleItems.Count) then
  begin
    if FStoredHint = cPipe then
      FStoredHint := Hint;
    if Action is TCustomAction then
      inherited Hint := TCustomAction(Action).Hint
    else
      inherited Hint := VisibleItems[NewIndex].Hint;
  end
  else
  begin
    NewIndex := -1;
    if FStoredHint <> cPipe then
      inherited Hint := FStoredHint;
    FStoredHint := cPipe;
  end;

  if NewIndex <> FHoverIndex then
  begin
    if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) then
      if FVisibleItems[FHoverIndex].Checked then
        DoDrawItem(FHoverIndex, [dsClicked])
      else
        DoDrawItem(FHoverIndex, []);
    FHoverIndex := NewIndex;
    if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and
      (FVisibleItems[FHoverIndex].Enabled) then
    begin
      DoDrawItem(FHoverIndex, [dsFocused]);
      if FShowLinkCursor then
        Cursor := crHandPoint;
    end
    else
    if FShowLinkCursor then
      Cursor := crDefault;
  end;

  inherited HookMouseMove(X, Y);
end;

procedure TJvXPCustomWinXPBar.HookParentFontChanged;
begin
  if ParentFont then
  begin
    FFontChanging := True;
    try
      FFont.Color := $00E75100;
      FFont.Name := inherited Font.Name;
      FFont.Size := 8;
      FFont.Style := inherited Font.Style;
      FHeaderFont.Color := $00E75100;
      FHeaderFont.Name := Font.Name;
      FHeaderFont.Size := 8;
      FHeaderFont.Style := [fsBold];
    finally
      FFontChanging := False;
    end;
    inherited HookParentFontChanged;
  end;
end;

procedure TJvXPCustomWinXPBar.HookResized;
begin
  // perform actions only on 'width'-change
  if FGradientWidth <> Width then
    FGradientWidth := Width;

  // resize to maximum height
  ResizeToMaxHeight;
  inherited HookResized;
end;

procedure TJvXPCustomWinXPBar.SetCollapsed(Value: Boolean);
begin
  if Value <> FCollapsed then
  begin
    // Using fading while loading is useless.
    // Using the fading thread at design time is NOT safe. See Mantis 3547.
    if ComponentState * [csLoading, csDesigning] = [] then
    begin
      if Assigned(FBeforeCollapsedChange) then
        FBeforeCollapsedChange(Self, Value);
      if Value then
        FFadeThread := TJvXPFadeThread.Create(Self, rdCollapse)
      else
        FFadeThread := TJvXPFadeThread.Create(Self, rdExpand);
      if Assigned(FOnCollapsedChange) then
        FOnCollapsedChange(Self, Value);
    end
    else
    begin
      FCollapsed := Value;
      FRolling := True;
      if Value then
        RollOffset := 0
      else
        RollOffset := FItemHeight;
      FRolling := False;
      if Grouped and not Value then
        GroupMessage;
    end;
  end;
end;

procedure TJvXPCustomWinXPBar.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
  InternalRedraw;
end;

procedure TJvXPCustomWinXPBar.SetHeaderFont(Value: TFont);
begin
  FHeaderFont.Assign(Value);
  InternalRedraw;
end;

procedure TJvXPCustomWinXPBar.SetHotTrack(Value: Boolean);
const
  MouseEvents: TJvXPControlStyle = [csRedrawMouseEnter, csRedrawMouseLeave];
begin
  if Value <> FHotTrack then
  begin
    FHotTrack := Value;
//    if FHotTrack then
//      ExControlStyle := ExControlStyle + MouseEvents
//    else
//      ExControlStyle := ExControlStyle - MouseEvents;
    if not (csLoading in ComponentState) then
      InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetHotTrackColor(Value: TColor);
begin
  if Value <> FHotTrackColor then
  begin
    FHotTrackColor := Value;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetIcon(Value: TIcon);
begin
  if Value <> FIcon then
  begin
    FIcon.Assign(Value);
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetImageList(Value: TCustomImageList);
begin
  if Value <> FImageList then
  begin
    if FImageList <> nil then
      FImageList.UnRegisterChanges(FImageChangeLink);
    FImageList := Value;
    if FImageList <> nil then
    begin
      FImageList.FreeNotification(Self);
      FImageList.RegisterChanges(FImageChangeLink);
    end;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetItemHeight(Value: Integer);
begin
  if Value <> FItemHeight then
  begin
    FItemHeight := Value;
    if not FCollapsed then
      RollOffset := FItemHeight;
  end;
end;

procedure TJvXPCustomWinXPBar.SetItems(Value: TJvXPBarItems);
begin
  FItems.Assign(Value);
end;

procedure TJvXPCustomWinXPBar.SetRollOffset(const Value: Integer);
begin
  if Value <> FRollOffset then
  begin
    FRollOffset := Value;
    ResizeToMaxHeight;
  end;
end;

procedure TJvXPCustomWinXPBar.SetShowRollButton(Value: Boolean);
begin
  if Value <> FShowRollButton then
  begin
    FShowRollButton := Value;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.EndUpdate;
begin
  inherited EndUpdate;
  ResizeToMaxHeight;
end;

procedure TJvXPCustomWinXPBar.Click;
var
  AllowChange, CallInherited: Boolean;
  LItem: TJvXPBarItem;
begin
  CallInherited := True;
  if FShowRollButton and (FHitTest <> htNone) then
    Collapsed := not Collapsed;
  if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and
    FVisibleItems[FHoverIndex].Enabled then
  begin
    AllowChange := True;
    if Assigned(FOnCanChange) then
      FOnCanChange(Self, FVisibleItems[FHoverIndex], AllowChange);
    if not AllowChange then
      Exit;

    //dejoy add
    LItem := FVisibleItems[FHoverIndex];
    with LItem do
    begin
      if (not Assigned(ActionLink) and AutoCheck) or
        (Assigned(ActionLink) and not ActionLink.IsAutoCheckLinked and AutoCheck) then
        LItem.Checked := not LItem.Checked;
    end;
    if FVisibleItems[FHoverIndex].Checked then
      DrawState := DrawState + [dsClicked]
    else
      DrawState := DrawState - [dsClicked];

    if Assigned(FOnItemClick) then
    begin
      FOnItemClick(Self, FVisibleItems[FHoverIndex]);
      CallInherited := False;
    end;
    if Assigned(FVisibleItems[FHoverIndex].FOnClick) then
    begin
      { set linked 'action' as Sender }
      if Assigned(FVisibleItems[FHoverIndex].Action) and
         (@FVisibleItems[FHoverIndex].FOnClick <> @FVisibleItems[FHoverIndex].Action.OnExecute) then
        FVisibleItems[FHoverIndex].FOnClick(FVisibleItems[FHoverIndex])
      else
      if not (csDesigning in ComponentState) and Assigned(FVisibleItems[FHoverIndex].ActionLink) then
        FVisibleItems[FHoverIndex].ActionLink.Execute(Self)
      else
      if Assigned(FVisibleItems[FHoverIndex].FOnClick) then
        FVisibleItems[FHoverIndex].FOnClick(FVisibleItems[FHoverIndex]);

      CallInherited := False;
    end;
    Collapsed := False;
    InternalRedraw; //dejoy
  end;
  if CallInherited then
    inherited Click;
end;

procedure TJvXPCustomWinXPBar.DoDrawItem(const Index: Integer; State: TJvXPDrawState);
var
  ItemRect: TRect;
begin
  with Canvas do
  begin
    ItemRect := GetItemRect(Index);
    if OwnerDraw then
    begin
      if Assigned(FOnDrawItem) then
        FOnDrawItem(Self, Canvas, ItemRect, State, FVisibleItems[Index]);
    end
    else
      FVisibleItems[Index].DrawItem(Self, Canvas, ItemRect, State, ShowItemFrame);
  end;
end;

procedure TJvXPCustomWinXPBar.Paint;
var
  ARect: TRect;
  Bitmap: TBitmap;
  Index, I: Integer;
  OwnColor: TColor;

  // (rom) Do as prefix for a local function is not ideal
  procedure DoDrawBackground(ACanvas: TCanvas; var R: TRect);
  begin
    ACanvas.Brush.Color := FColors.BodyColor; // $00F7DFD6;
    Inc(R.Top, FTopSpace + FHeaderHeight);
    if OwnerDraw then
    begin
      if Assigned(FOnDrawBackground) then
        FOnDrawBackground(Self, ACanvas, R);
    end
    else
    begin
      if not FCollapsed and (FColors.FBodyColor <> FColors.FBodyBorderColor) then
      begin
        ACanvas.Pen.Color := FColors.FBodyBorderColor;
        ACanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom - 1);
      end
      else
        ACanvas.FillRect(R);
    end;
  end;

  procedure DoDrawHeader(ACanvas: TCanvas; var R: TRect);
  begin
    Dec(R.Top, FHeaderHeight);
    R.Bottom := R.Top + FHeaderHeight;
    if OwnerDraw then
    begin
      ACanvas.Brush.Color := FColors.FBorderColor;
      if Assigned(FOnDrawHeader) then
        FOnDrawHeader(Self, ACanvas, R);
    end
    else
    begin
      ACanvas.GradientFill(Rect(0, R.Top, Width, R.Top + FHeaderHeight),
        FColors.GradientFrom, FColors.GradientTo, gdHorizontal);
      
      { draw frame... }
      ACanvas.Brush.Color := FColors.FBorderColor;
      ACanvas.FrameRect(R);

      if FHeaderRounded then
      begin
        OwnColor := TJvXPWinControl(Parent).Brush.Color;
        ACanvas.Pixels[0, R.Top] := OwnColor;
        ACanvas.Pixels[0, R.Top + 1] := OwnColor;
        ACanvas.Pixels[1, R.Top] := OwnColor;
        ACanvas.Pixels[1, R.Top + 1] := FColors.FBorderColor;
        ACanvas.Pixels[Width - 1, R.Top] := OwnColor;
        ACanvas.Pixels[Width - 2, R.Top] := OwnColor;
        ACanvas.Pixels[Width - 1, R.Top + 1] := OwnColor;
        ACanvas.Pixels[Width - 2, R.Top + 1] := FColors.FBorderColor;
      end;

      // Paint rollover button: (expanded/collapsed state button images)
      if FShowRollButton and (Width >= 115) then
      begin
        Bitmap := TBitmap.Create;
        try
          if Assigned(FRollImages) then
          begin
          // format:
          // 0 - normal collapsed
          // 1 - normal expanded
          // 2 - hot collapsed
          // 3 - hot expanded
          // 4 - down collapsed
          // 5 - down expanded
            Index := 0; // normal
            if FHitTest = htRollButton then
            begin
              if dsHighlight in DrawState then
                Index := 2; // hot
              if (dsClicked in DrawState) and (dsHighlight in DrawState) then
                Index := 4; // down
            end;
            if not FCollapsed then
              Inc(Index);
            if Index >= FRollImages.Count then
              Index := Ord(not FCollapsed);
            FRollImages.GetBitmap(Index, Bitmap);
          end
          else
          begin
            Index := 0;
            if FHitTest = htRollButton then
            begin
              if dsHighlight in DrawState then
                Index := 1; // hot
              if (dsClicked in DrawState) and (dsHighlight in DrawState) then
                Index := 2; // down
            end;
            Bitmap.Assign(nil); // fixes GDI resource leak
            if FCollapsed then
              //Bitmap.LoadFromResourceName(HInstance, 'JvXPCustomWinXPBarEXPAND' + IntToStr(Index))
              Bitmap.LoadFromLazarusResource('JvXPCustomWinXPBarEXPAND' + IntToStr(Index))
            else
              //Bitmap.LoadFromResourceName(HInstance, 'JvXPCustomWinXPBarCOLLAPSE' + IntToStr(Index));
              Bitmap.LoadFromLazarusResource('JvXPCustomWinXPBarCOLLAPSE' + IntToStr(Index));
          end;
          // Transparency fix not needed Here! -WPostma
          Bitmap.Transparent := True;
          ACanvas.Draw(R.Right - 24, R.Top + (HeaderHeight - GetRollHeight) div 2, Bitmap);
        finally
          Bitmap.Free;
        end;
        Dec(R.Right, 25);
      end;
      Inc(R.Left, 22);
      ACanvas.Pen.Color := FColors.SeparatorColor;
      JvXPDrawLine(ACanvas, 1, ARect.Top + FHeaderHeight, Width - 1, ARect.Top + FHeaderHeight);
      if not FIcon.Empty then
      begin
        ACanvas.Draw(2, 0, FIcon);
        Inc(R.Left, 16);
      end;
      Dec(ARect.Right, 25);
    end;

    { draw seperator line }
    ACanvas.Pen.Color := FColors.SeparatorColor;
    JvXPDrawLine(ACanvas, 1, ARect.Top + FHeaderHeight, Width - 1, ARect.Top + FHeaderHeight);

    { draw icon }
//    Inc(ARect.Left, 22);
    if not FIcon.Empty then
    begin
      ACanvas.Draw(2, 1, FIcon);
      Inc(ARect.Left, 6);
    end
    else
      Dec(ARect.Left, 16);
    SetBkMode(ACanvas.Handle, TRANSPARENT);
    ACanvas.Font.Assign(FHeaderFont);
    if FHotTrack and (dsHighlight in DrawState) and (FHitTest <> htNone) and (FHotTrackColor <> clNone) then
      ACanvas.Font.Color := FHotTrackColor;
    ARect.Bottom := ARect.Top + FHeaderHeight;
    Dec(ARect.Right, 3);
    //{$IFDEF USEJVCL}
    //DrawText(ACanvas, Caption, -1, ARect,
    //  DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
    //{$ELSE}
    DrawText(ACanvas.Handle, PChar(Caption), Length(Caption), ARect,
      DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
  end;
begin
  { get client rect }
  ARect := GetClientRect;
  DoDrawBackground(Canvas, ARect);
  { draw header }
  DoDrawHeader(Canvas, ARect);
  { draw visible items }
  Canvas.Brush.Color := FColors.BodyColor;
  if not FCollapsed or FRolling then
    for I := 0 to FVisibleItems.Count - 1 do
      if FVisibleItems[I].Checked then
        DoDrawItem(I, [dsClicked])
      else
        DoDrawItem(I, []);
end;

procedure TJvXPCustomWinXPBar.WMAfterXPBarCollapse(var Msg: TLMessage);
begin
  if Assigned(FAfterCollapsedChange) then
    FAfterCollapsedChange(Self, Msg.WParam <> 0);
  if Grouped and not FCollapsed then
    GroupMessage;
end;

procedure TJvXPCustomWinXPBar.DoColorsChange(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvXPCustomWinXPBar.SetColors(const Value: TJvXPBarColors);
begin
  FColors.Assign(Value);
end;

procedure TJvXPCustomWinXPBar.SetRollImages(const Value: TCustomImageList);
begin
  if FRollImages <> Value then
  begin
    if FRollImages <> nil then
      FRollImages.UnRegisterChanges(FRollChangeLink);
    FRollImages := Value;
    if FRollImages <> nil then
    begin
      FRollImages.FreeNotification(Self);
      FRollImages.RegisterChanges(FRollChangeLink);
    end;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.GroupMessage;
var
  Msg: TLMessage;
begin
  if Parent <> nil then
  begin
    Msg.Msg := WM_XPBARAFTEREXPAND;
    Msg.WParam := WPARAM(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;

procedure TJvXPCustomWinXPBar.WMAfterXPBarExpand(var Msg: TLMessage);
begin
  if Grouped and (TObject(Msg.WParam) <> Self) then
    Collapsed := True;
end;

procedure TJvXPCustomWinXPBar.SetGrouped(const Value: Boolean);
begin
  if FGrouped <> Value then
  begin
    FGrouped := Value;
    if FGrouped and not Collapsed then
      Collapsed := True;
  end;
end;

procedure TJvXPCustomWinXPBar.AdjustClientRect(var Rect: TRect);
begin
  inherited AdjustClientRect(Rect);
  if ControlCount > 0 then
  begin
    Inc(Rect.Top, FHeaderHeight + 4);
    InflateRect(Rect, -4, -4);
  end;
end;

procedure TJvXPCustomWinXPBar.SetHeaderHeight(const Value: Integer);
begin
  if FHeaderHeight <> Value then
  begin
    FHeaderHeight := Value;
    ResizeToMaxHeight;
//    InternalRedraw;
  end;
end;

function TJvXPCustomWinXPBar.HintShow(var HintInfo: THintInfo): Boolean;
begin
  // draw the item hint (if available)
  if (FHoverIndex > -1) and (FVisibleItems[FHoverIndex] <> nil) then
  begin
    HintInfo.CursorRect := GetItemRect(FHoverIndex);
    with VisibleItems[FHoverIndex] do
    begin
      if Action is TCustomAction then
        HintInfo.HintStr := TCustomAction(Action).Hint
      else
        HintInfo.HintStr := VisibleItems[FHoverIndex].Hint;
    end;
  end
  else
  if (VisibleItems.Count > 0) and not Collapsed then
    HintInfo.CursorRect := GetHitTestRect(htHeader);

  if HintInfo.HintStr = '' then
    HintInfo.HintStr := Hint;
  Result := False; // use default hint window
end;

procedure TJvXPCustomWinXPBar.CMHintShow(var Msg: TCMHintShow);
begin
  Msg.Result := Ord(HintShow(Msg.HintInfo^));
end;

function TJvXPBarItemActionLink.DoShowHint(var HintStr: string): Boolean;
begin
  Result := True;
  if Action is TCustomAction then
  begin
    Result := TCustomAction(Action).DoHint(HintStr);
    if Result and Application.HintShortCuts and (TCustomAction(Action).ShortCut <> scNone) then
      if HintStr <> '' then
        HintStr := Format(RsHintShortcutFmt, [HintStr, ShortCutToText(TCustomAction(Action).ShortCut)]);
  end;
end;

procedure TJvXPCustomWinXPBar.InitiateAction;
var
  I: Integer;
begin
  inherited InitiateAction;
  // go through each item and update
  // Note: Do not call ActionChange as it would trigger Mantis 3244 and it is
  // basically wrong as the point of InitiateAction is to call Update (see in
  // the inherited code).
  for I := 0 to Items.Count - 1 do
    if Assigned(Items[I].ActionLink) then
      Items[I].ActionLink.Update;
end;


procedure TJvXPCustomWinXPBar.CMDialogChar(var Msg: TCMDialogChar);
var
  I: Integer;
begin
  if CanFocus then
  begin
    if IsAccel(Msg.CharCode, Caption) then
    begin
      Collapsed := not Collapsed;
      Msg.Result := 1;
    end
    else
    if not Collapsed then
      for I := 0 to VisibleItems.Count - 1 do
        if IsAccel(Msg.CharCode, VisibleItems[I].Caption) and VisibleItems[I].Enabled then
        begin
          Msg.Result := 1;
          FHitTest := htNone;
          FHoverIndex := I;
          Click;
          Exit;
        end;
  end;
  // 21.07.2007 - SESS: Parece no estar en la clase base
  // inherited;
end;

class function TJvXPCustomWinXPBar.GetBarItemsClass: TJvXPBarItemsClass;
begin
  Result := TJvXPBarItems;
end;

procedure TJvXPCustomWinXPBar.DblClick;
var
  LItem: TJvXPBarItem;
begin
  if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and
    FVisibleItems[FHoverIndex].Enabled then
  begin
    LItem := FVisibleItems[FHoverIndex];
    if Assigned(LItem.FOnDblClick) then
      LItem.FOnDblClick(LItem);
  end;
  inherited DblClick;
end;

procedure RoundedFrame(Canvas: TCanvas; ARect: TRect; AColor: TColor; R: Integer);
begin
  // Draw Frame with round edges
  with Canvas, ARect do
  begin
    Pen.Color := AColor;
    Dec(Right);
    Dec(Bottom);
    Polygon(
     [Point(Left + R, Top),
      Point(Right - R, Top),
      Point(Right, Top + R),
      Point(Right, Bottom - R),
      Point(Right - R, Bottom),
      Point(Left + R, Bottom),
      Point(Left, Bottom - R),
      Point(Left, Top + R),
      Point(Left + R, Top)]);
    Inc(Right);
    Inc(Bottom);
  end;
end;

procedure TJvXPCustomWinXPBar.SetHeaderRounded(const Value: Boolean);
begin
  if FHeaderRounded <> Value then
  begin
    FHeaderRounded := Value;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetTopSpace(const Value: Integer);
begin
  if Value <> FTopSpace then
  begin
    FTopSpace := Value;
    if FTopSpace < 0 then
      FTopSpace := 0;
    ResizeToMaxHeight;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetOwnerDraw(const Value: Boolean);
begin
  if FOwnerDraw <> Value then
  begin
    FOwnerDraw := Value;
    Invalidate;
  end;
end;

initialization
  {$I JvXPBar.lrs}

end.