dxwinxpbar.pas

delphi控件可以很好实现应用程序的界面设计

{*******************************************************************}
{                                                                   }
{   Design eXperince Visual Component Library                       }
{   WinXPBar (dxWinXPBar)                                           }
{                                                                   }
{   Copyright (c) 2002 APRIORI business solutions AG                }
{   (W)ritten by M. Hoffmann - ALL RIGHTS RESERVED.                 }
{                                                                   }
{   DEVELOPER NOTES:                                                }
{   ==========================================================      }
{   This file is part of a component suite called Design            }
{   eXperience and may be used in freeware- or commercial           }
{   applications. The package itself is distributed as              }
{   freeware with full sourcecodes.                                 }
{                                                                   }
{   Feel free to fix bugs or include new features if you are        }
{   familiar with component programming. If so, please email        }
{   me your modifications, so it will be possible for me to         }
{   include nice improvements in further releases:                  }
{                                                                   }
{   HISTORY:                                                        }
{   =============================================================== }
{   2003/02/06                                                      }
{     + First Release.                                              }
{                                                                   }
{*******************************************************************}

unit dxWinXPBar;

interface

uses
  Forms, Windows, Classes, Controls, Graphics, SysUtils, ImgList, ActnList,
  dxCore, dxCoreUtils;

{$R dxWinXPBar.res}

type
{ TdxWinXPBarRollDirection

  Warning: Never change order of enumeration because of
           hardcoded type castes! }

  TdxWinXPBarRollDirection = (
    rdExpand,           // expand roll
    rdCollapse          // collapse roll
  );

{ TdxWinXPBarRollMode }

  TdxWinXPBarRollMode = (
    rmFixed,            // fixed mode (default)
    rmShrink            // shrink mode
  );

{ TdxWinXPBarHitTest }

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

{ forward declarations }

  TdxWinXPBarItem = class;
  TdxWinXPBarItems = class;
  TdxCustomWinXPBar = class;

{ TdxWinXPBarOnCanChangeEvent }

  TdxWinXPBarOnCanChangeEvent = procedure(Sender: TObject; Item: TdxWinXPBarItem;
    var AllowChange: Boolean) of object;

{ TdxWinXPBarOnDrawItemEvent }

  TdxWinXPBarOnDrawItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
    Rect: TRect; State: TdxDrawState; Item: TdxWinXPBarItem; Bitmap: TBitmap) of object;

{ TdxWinXPBarOnItemClickEvent }

  TdxWinXPBarOnItemClickEvent = procedure(Sender: TObject; Item: TdxWinXPBarItem) of object;

{ TdxWinXPBarItemActionLink }

  TdxWinXPBarItemActionLink = class(TActionLink)
  protected
    FClient: TdxWinXPBarItem;
    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;

{ TdxWinXPBarItemActionLinkClass }

  TdxWinXPBarItemActionLinkClass = class of TdxWinXPBarItemActionLink;

{ TdxWinXPBarItem }

  TdxWinXPBarItem = class(TCollectionItem)
  private
    FActionLink: TdxWinXPBarItemActionLink;
    FCollection: TdxWinXPBarItems;
    FCaption: TCaption;
    FData: Pointer;
    FDataObject: TObject;
    FEnabled: Boolean;
    FHint: string;
    FImageIndex: TImageIndex;
    FImageList: TCustomImageList;
    FName: string;
    FWinXPBar: TdxCustomWinXPBar;
    FTag: Integer;
    FVisible: Boolean;
    FOnClick: TNotifyEvent;
    function IsCaptionStored: Boolean;
    function IsEnabledStored: Boolean;
    function IsHintStored: Boolean;
    function IsImageIndexStored: Boolean;
    function IsVisibleStored: Boolean;
    function IsOnClickStored: 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(Value: string);
    procedure SetVisible(Value: Boolean);
  protected
    function GetActionLinkClass: TdxWinXPBarItemActionLinkClass; dynamic;
    function GetAction: TBasicAction; virtual;
    function GetDisplayName: string; override;
    procedure Notification(AComponent: TComponent); virtual;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
    property ActionLink: TdxWinXPBarItemActionLink 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: TdxCustomWinXPBar read FWinXPBar;
  published
    property Action: TBasicAction read GetAction write SetAction;
    property Caption: TCaption read FCaption write SetCaption stored IsCaptionStored;
    property Enabled: Boolean read FEnabled write SetEnabled stored IsEnabledStored
      default True;
    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;
  end;

{ TdxWinXPBarItems }

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

{ TdxWinXPBarVisibleItems }

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

{ TdxFadeThread }

  TdxFadeThread = class(TThread)
  private
    FWinXPBar: TdxCustomWinXPBar;
    FRollDirection: TdxWinXPBarRollDirection;
  public
    constructor Create(WinXPBar: TdxCustomWinXPBar; RollDirection: TdxWinXPBarRollDirection);
    procedure Execute; override;
  end;

{ TdxCustomWinXPBar }

  TdxCustomWinXPBar = class(TdxCustomControl)
  private
    FBodyColor: TColor;
    FCollapsed: Boolean;
    FFadeThread: TdxFadeThread;
    FFont: TFont;
    FFontChanging: Boolean;
    FGradient: TBitmap;
    FGradientFrom: TColor;
    FGradientTo: TColor;
    FGradientWidth: Integer;
    FHeaderFont: TFont;
    FHitTest: TdxWinXPBarHitTest;
    FHotTrack: Boolean;
    FHotTrackColor: TColor;
    FHoverIndex: Integer;
    FIcon: TIcon;
    FImageList: TCustomImageList;
    FItemHeight: Integer;
    FItems: TdxWinXPBarItems;
    FRolling: Boolean;
    FRollMode: TdxWinXPBarRollMode;
    FRollOffset: Integer;
    FSeperatorLine: TColor;
    FShowLinkCursor: Boolean;
    FShowRollButton: Boolean;
    FVisibleItems: TdxWinXPBarVisibleItems;
    FOnCanChange: TdxWinXPBarOnCanChangeEvent;
    FOnDrawItem: TdxWinXPBarOnDrawItemEvent;
    FOnItemClick: TdxWinXPBarOnItemClickEvent;
    function IsFontStored: Boolean;
    procedure FontChanged(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: TdxWinXPBarItems);
    procedure SetRollOffset(const Value: Integer);
    procedure SetShowRollButton(Value: Boolean);
    procedure ResizeToMaxHeight;
  protected
    function GetHitTestRect(const HitTest: TdxWinXPBarHitTest): TRect;
    function GetItemRect(Index: Integer): TRect; virtual;
    procedure ItemVisibilityChanged(Item: TdxWinXPBarItem); dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure HookMouseDown; override;
    procedure HookMouseMove(X: Integer = 0; Y: Integer = 0); override;
    procedure HookParentFontChanged; override;
    procedure HookResized; override;
    procedure SortVisibleItems(const Redraw: Boolean);
    procedure DoDrawItem(const Index: Integer; State: TdxDrawState); virtual;
    procedure Paint; override;
    property Collapsed: Boolean read FCollapsed write SetCollapsed default False;
    property Font: TFont read FFont write SetFont stored IsFontStored;
    property HeaderFont: TFont read FHeaderFont write SetHeaderFont stored IsFontStored;
    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: TdxWinXPBarItems read FItems write SetItems;
    property Rolling: Boolean read FRolling default False;
    property RollMode: TdxWinXPBarRollMode read FRollMode write FRollMode default rmShrink;
    property RollOffset: Integer read FRollOffset write SetRollOffset;
    property ShowLinkCursor: Boolean read FShowLinkCursor write FShowLinkCursor default True;
    property ShowRollButton: Boolean read FShowRollButton write SetShowRollButton default True;
    property OnCanChange: TdxWinXPBarOnCanChangeEvent read FOnCanChange write FOnCanChange;
    property OnDrawItem: TdxWinXPBarOnDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnItemClick: TdxWinXPBarOnItemClickEvent read FOnItemClick write FOnItemClick;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetHitTestAt(X, Y: Integer): TdxWinXPBarHitTest;
    procedure EndUpdate; override;
    procedure Click; override;
    property Height default 46;
    property VisibleItems: TdxWinXPBarVisibleItems read FVisibleItems;
    property Width default 153;
  end;

{ TdxWinXPBar }

  TdxWinXPBar = class(TdxCustomWinXPBar)
  published
    property Caption;
    property Collapsed;
    property Font;
    property HeaderFont;
    property HotTrack;
    property HotTrackColor;
    property Icon;
    property ImageList;
    property ItemHeight;
    property Items;
    property RollMode;
    property ShowLinkCursor;
    property ShowRollButton;
    property OnCanChange;
    property OnDrawItem;
    property OnItemClick;
  end;

implementation

const
  FC_HEADER_HEIGHT = 34;
  FC_ITEM_MARGIN   = 8;

{-----------------------------------------------------------------------------
  Procedure: SortByIndex
  Author:    mh
  Date:      25-Okt-2002
  Arguments: Item1, Item2: Pointer
  Result:    Integer
-----------------------------------------------------------------------------}

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;

{ TdxWinXPBarItemActionLink }

{-----------------------------------------------------------------------------
  Procedure: TdxWinXPBarItemActionLink.AssignClient
  Author:    mh
  Date:      25-Okt-2002
  Arguments: AClient: TObject
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxWinXPBarItemActionLink.AssignClient(AClient: TObject);
begin
  FClient := AClient as TdxWinXPBarItem;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxWinXPBarItemActionLink.IsCaptionLinked
  Author:    mh
  Date:      25-Okt-2002
  Arguments: None
  Result:    Boolean
-----------------------------------------------------------------------------}

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

{-----------------------------------------------------------------------------
  Procedure: TdxWinXPBarItemActionLink.IsEnabledLinked
  Author:    mh
  Date:      25-Okt-2002
  Arguments: None
  Result:    Boolean
-----------------------------------------------------------------------------}

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

{-----------------------------------------------------------------------------
  Procedure: TdxWinXPBarItemActionLink.IsHintLinked
  Author:    mh
  Date:      25-Okt-2002