jvxpbar.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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,v 1.88 2005/03/07 16:45:17 wpostma Exp $

unit JvXPBar;

{$I jvcl.inc}

// sorry no theming as standalone

{$IFNDEF USEJVCL}
{$UNDEF JVCLThemesEnabled}
{$UNDEF JVCLThemesEnabledD56}
{$ENDIF !USEJVCL}

// XP_TRANSPARENCY_FIX:
//  WinXPSP2/WinServer2003 transparency workaround:
//  Define to add calls to BitmapBgPaint to pre-paint
//  bitmap using XPBar.Colors.BodyColor, to fix
//  transparency issues.  Note that this is a real
//  bug in Windows XP and 2003 and once all machines
//  "OUT THERE" have been updated, this should be removed
//  from the code.
{$define XP_TRANSPARENCY_FIX}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Classes, SysUtils,
  Graphics, Controls, Forms, ExtCtrls, ImgList, ActnList, Messages,
  {$IFDEF VisualCLX}
  Qt, QTypes, JvQTypes,
  {$ENDIF VisualCLX}
  {$IFDEF USEJVCL}
  JvConsts,
  {$ENDIF USEJVCL}
  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);
  {$IFDEF VisualCLX}
  clHotLight = clActiveHighlight;
  {$ENDIF VisualCLX}
  {$IFNDEF USEJVCL} // VisualCLX activates USEJVCL
  clHotLight = TColor(COLOR_HOTLIGHT or $80000000);
  {$ENDIF !USEJVCL}

  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; Bitmap: TBitmap) 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;
    {$IFDEF VCL}
    procedure SetCaption(const Value: string); override;
    procedure SetHint(const Value: string); override;
    function DoShowHint(var HintStr: string): Boolean; virtual;
    {$IFDEF COMPILER6_UP}
    function IsAutoCheckLinked: Boolean; virtual;
    procedure SetAutoCheck(Value: Boolean); override;
    {$ENDIF COMPILER6_UP}
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    procedure SetCaption(const Value: TCaption); override;
    procedure SetHint(const Value: WideString); override;
    function DoShowHint(var HintStr: WideString): Boolean; virtual;
    {$ENDIF VisualCLX}
    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;
    {$IFDEF VCL}
    FAutoCheck: Boolean;
    {$IFDEF COMPILER6_UP}
    function IsAutoCheckStored: Boolean;
    {$ENDIF COMPILER6_UP}
    {$ENDIF VCL}
    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; Bitmap: TBitmap); virtual;
    property ActionLink: TJvXPBarItemActionLink read FActionLink write FActionLink;
  public
    constructor Create(Collection: 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;
    {$IFDEF VCL}
    property AutoCheck: Boolean read FAutoCheck write FAutoCheck {$IFDEF COMPILER6_UP} stored IsAutoCheckStored {$ENDIF} default False;
    {$ENDIF VCL}
    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;
  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;
    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);
  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 TColor($00F7DFD6);
    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;
    FGradient: TBitmap;
    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;
    function IsFontStored: Boolean;
    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
    {$IFDEF VCL}
    procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    function WantKey(Key: Integer; Shift: TShiftState;
      const KeyText: WideString): Boolean; override;
    {$ENDIF VisualCLX}
    class function GetBarItemsClass: TJvXPBarItemsClass; virtual;
    function GetHitTestRect(const HitTest: 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;