outlookbar.pas

企业ERP管理系统

unit OutlookBar;

interface

uses
  Classes, SysUtils, Windows, Messages, Graphics, Controls, Imglist;

type
  TOutlookBarItems = class;
  TOutlookBarPage = class;
  TOutlookBarPages = class;
  TCustomOutlookBar = class;

  TDrawOutlookBarItemTitleBorderStyle = set of (dsFlat, dsHot, dsDown, dsRedraw);

  TOutlookBarItem = class(TPersistent)
  private
    FData: Pointer;
    FCaption: string;
    FExpanded: Boolean;
    FItems: TList;
    FOwner: TOutlookBarItems;
    FParent: TOutlookBarItem;
    FImageIndex: Integer;
    FDown: Boolean;
    FLastDrawBorderStyle: TDrawOutlookBarItemTitleBorderStyle;
    function GetCount:Integer;
    function GetPage: TOutlookBarPage;
    function GetParent: TOutlookBarItem;
    function GetOutlookBar: TCustomOutlookBar;
    function GetOutlookBarItems: TOutlookBarItems;
    function GetIndex: Integer;
    function GetParentList: TList;
    function GetItem(Index: Integer): TOutlookBarItem;
    function GetLevel: Integer;
    procedure SetCaption(Value: string);
    procedure SetImageIndex(Value: Integer);
    procedure SetItem(Index: Integer; Value: TOutlookBarItem);
    procedure SetExpanded(Value: Boolean);
  protected
    function GetOwner: TPersistent; override;
    function CanVisible: Boolean; virtual;
  public
    constructor Create(AOwner: TOutlookBarItems);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    function GetPrev: TOutlookBarItem;
    function GetPrevVisible: TOutlookBarItem;
    function GetNext: TOutlookBarItem;
    function GetNextSibling: TOutlookBarItem;
    function GetNextVisible: TOutlookBarItem;
    property Count: Integer read GetCount;
    property Page: TOutlookBarPage read GetPage;
    property Parent: TOutlookBarItem read GetParent;
    property Owner: TOutlookBarItems read GetOutlookBarItems;
    property OutlookBar:TCustomOutlookBar read GetOutlookBar;
    property Items[Index: Integer]: TOutlookBarItem read GetItem write SetItem; default;
    property Index: Integer read GetIndex;
    property Data: Pointer read FData write FData;
    property Level: Integer read GetLevel;
  published
    property Expanded: Boolean read FExpanded write SetExpanded;
    property Caption: string read FCaption write SetCaption;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
  end;

  TOutlookBarItems = class(TPersistent)
  private
    FItems: TList;
    FOwner: TOutlookBarPage;
    function GetCount:Integer;
    function GetItem(Index: Integer): TOutlookBarItem;
    procedure SetItem(Index: Integer; Value: TOutlookBarItem);
    function GetPage: TOutlookBarPage;
  public
    constructor Create(AOwner: TOutlookBarPage);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function Insert(Parent: TOutlookBarItem; Index: Integer): TOutlookBarItem;
    procedure Clear;
    function GetVisibleItem(Index:Integer): TOutlookBarItem;
//    function GetItemOfAll(Index:Integer): TOutlookBarItem;
    property Count: Integer read GetCount;
    property Owner: TOutlookBarPage read GetPage;
    property Items[Index: Integer]: TOutlookBarItem read GetItem write SetItem; default;
  end;

  TDrawOutlookBarPageTitleBorderStyle = TDrawOutlookBarItemTitleBorderStyle;

  TLookBarIconStyle = (isLarge, isSmall);

  TOutlookBarPage = class(TCollectionItem)
  private
    FData: Pointer;
    FOffset: Integer;
    FItems: TOutlookBarItems;
    FLastDrawTitleBorderStyle: TDrawOutlookBarPageTitleBorderStyle;
    FCaption: string;
    FDown: Boolean;
    FIconStyle: TLookBarIconStyle;
    FTitleRect: TRect;
    function GetPages: TOutlookBarPages;
    function GetOutlookBar: TCustomOutlookBar;
    function GetTitleRect: TRect;
    procedure SetCaption(Value: string);
    procedure SetItems(Value: TOutlookBarItems);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Owner: TOutlookBarPages read GetPages;
    property OutlookBar:TCustomOutlookBar read GetOutlookBar;
    property Data: Pointer read FData write FData;
    property TitleRect: TRect read GetTitleRect;
  published
    property Caption: string read FCaption write SetCaption;
    property Items: TOutlookBarItems read FItems write SetItems;
    property IconStyle: TLookBarIconStyle read FIconStyle write FIconStyle;
  end;

  TOutlookBarPages = class(TCollection)
  private
    FOutlookBar: TCustomOutlookBar;
    function GetOutlookBar: TCustomOutlookBar;
    function GetItem(Index: Integer): TOutlookBarPage;
    procedure SetItem(Index: Integer; Value: TOutlookBarPage);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TCustomOutlookBar); virtual;
    function Add: TOutlookBarPage;
    property Owner: TCustomOutlookBar read GetOutlookBar;
    property Items[Index: Integer]: TOutlookBarPage read GetItem write SetItem; default;
  end;

  TOutlookBarItemNotifyEvent = procedure (Sender: TObject; AItem: TOutlookBarItem) of object;

  TCustomOutlookBar = class(TCustomControl)
  private
    FAnimating: Boolean;
    FFlat: Boolean;
    FLargeChangeLink: TChangeLink;
    FLargeImages: TCustomImageList;
    FPages: TOutlookBarPages;
    FPageIndex: Integer;
    FSmallChangeLink: TChangeLink;
    FSmallImages: TCustomImageList;
    FVisibleItems: TList;
    FWorkArea: TRect;

    FScrollUpDown: Boolean;
    FScrollDownDown: Boolean;

    FOnItemClick: TOutlookBarItemNotifyEvent;
    FOnPageChange: TNotifyEvent;
    function CanScrollUp: Boolean;
    function CanScrollDown: Boolean;
    function GetScrollUpRect: TRect;
    function GetScrollDownRect: TRect;

    procedure DrawScrollButtons;
    procedure ScrollUp;
    procedure ScrollDown;

    procedure SetPages(Value: TOutlookBarPages);
    procedure SetPageIndex(Value: Integer);
    procedure SetLargeImages(Value: TCustomImageList);
    procedure SetSmallImages(Value: TCustomImageList);
    procedure CMMouseLeave(var Message:TMessage); message CM_MOUSELEAVE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;

    procedure LayoutChanged; virtual;

    procedure ClickPageTitle(Page: TOutlookBarPage); virtual;
    procedure ClickItem(Item: TOutlookBarItem); virtual;

    function GetWorkArea: TRect;
    function GetPageTitleRect(Page: TOutlookBarPage): TRect;
    function GetItemRect(Item: TOutlookBarItem): TRect;
    function GetItemBorderRect(Item: TOutlookBarItem; ARect: TRect; IncludeCaption: 
        Boolean = False): TRect;

    procedure DrawPageTitle(Page: TOutlookBarPage; const ARect:TRect); virtual;
    procedure DrawPageTitleBorder(Page: TOutlookBarPage; const ARect:TRect; ADrawStyle: TDrawOutlookBarPageTitleBorderStyle); virtual;
    procedure DrawItems(const ARect: TRect); virtual;
    procedure MeasurePageTitle(Page: TOutlookBarPage; var Width, Height: Integer); virtual;

    procedure MeasureItem(Item: TOutlookBarItem; var Width, Height: Integer); virtual;
    procedure DrawItem(Item: TOutlookBarItem; const ARect: TRect); virtual;
    procedure DrawItemBorder(Item: TOutlookBarItem; const ARect: TRect; ADrawStyle: TDrawOutlookBarPageTitleBorderStyle); virtual;

    property LargeImages: TCustomImageList read FLargeImages write SetLargeImages;
    property SmallImages: TCustomImageList read FSmallImages write SetSmallImages;
    property Pages: TOutlookBarPages read FPages write SetPages;
    property Flat: Boolean read FFlat write FFlat;
    property Color default clAppWorkSpace;
    property OnItemClick: TOutlookBarItemNotifyEvent read FOnItemClick write FOnItemClick;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    function GetPageAt(X, Y: Integer): TOutlookBarPage;
    function GetItemAt(X, Y: Integer): TOutlookBarItem;
    function GetFirstVisibleItem: TOutlookBarItem;

    procedure UpdateItem(Item: TOutlookBarItem);
    procedure UpdatePage(Page: TOutlookBarPage);
  published
    property PageIndex: Integer read FPageIndex write SetPageIndex;
    property OnPageChange: TNotifyEvent read FOnPageChange write FOnPageChange;
  end;

  TOutlookBar = class(TCustomOutlookBar)
  published
    //inherited
    property Align;
    property Anchors;
    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderWidth;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDockDrop;
    property OnDockOver;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;

    property Flat;
    property Pages;
    property LargeImages;
    property SmallImages;

    property OnItemClick;
  end;

implementation

procedure TextSize(Font: TFont; const S: string; var Width, Height:Integer);
var
  DC: HDC;
  SaveFont: HFont;
  rt: TRect;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, Font.Handle);
  FillChar(rt,SizeOf(rt),0);
  DrawText(DC, PChar(S), Length(S), rt, DT_CALCRECT);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Width := rt.Right - rt.Left;
  Height := rt.Bottom - rt.Top;
end;

{TOutlookBarItem}
constructor TOutlookBarItem.Create(AOwner: TOutlookBarItems);
begin
  inherited Create;
  FOwner := AOwner;
  FItems := TList.Create;
end;

destructor TOutlookBarItem.Destroy;
begin
  Clear;
  GetParentList.Remove(Self);
  FItems.Free;
  inherited Destroy;
end;

function TOutlookBarItem.GetCount:Integer;
begin
  Result := FItems.Count;
end;

function TOutlookBarItem.GetPage: TOutlookBarPage;
begin
  Result := Owner.Owner;
end;

function TOutlookBarItem.GetParent: TOutlookBarItem;
begin
  Result := FParent;
end;

function TOutlookBarItem.GetOutlookBar: TCustomOutlookBar;
begin
  Result := Page.OutlookBar;
end;

function TOutlookBarItem.GetIndex: Integer;
begin
  Result := GetParentList.IndexOf(Self);
end;

function TOutlookBarItem.GetParentList: TList;
begin
  if Assigned(Parent) then Result := Parent.FItems else Result := Owner.FItems;
end;

function TOutlookBarItem.GetItem(Index: Integer): TOutlookBarItem;
begin
  Result := FItems[Index];
end;

function TOutlookBarItem.GetOutlookBarItems: TOutlookBarItems;
begin
  Result := FOwner;
end;

function TOutlookBarItem.CanVisible: Boolean;
begin
  if Assigned(Parent) then Result := Parent.CanVisible and Parent.Expanded
    else Result := Outlookbar.Visible;
end;

function TOutlookBarItem.GetLevel: Integer;
var
  P: TOutlookBarItem;
begin
  Result := 0;
  P := Parent;
  while Assigned(P) do
  begin
    Inc(Result);
    P := P.Parent;
  end;
end;

procedure TOutlookBarItem.SetCaption(Value: string);
begin
  FCaption := Value;
  OutlookBar.UpdateItem(Self);
end;

procedure TOutlookBarItem.SetImageIndex(Value: Integer);
begin
  FImageIndex := Value;
  OutlookBar.UpdateItem(Self);
end;

procedure TOutlookBarItem.SetItem(Index: Integer; Value: TOutlookBarItem);
begin
  Items[Index].Assign(Value);
end;

procedure TOutlookBarItem.SetExpanded(Value: Boolean);
begin
  FExpanded := Value;
  if Count = 0 then OutlookBar.UpdateItem(Self) else OutlookBar.UpdateItem(nil);
end;

function TOutlookBarItem.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TOutlookBarItem.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TOutlookBarItem then
  begin
    FData := TOutlookBarItem(Source).FData;
    FCaption := TOutlookBarItem(Source).FCaption;
    FExpanded := TOutlookBarItem(Source).FExpanded;
    Clear;
    for I := 0 to TOutlookBarItem(Source).Count - 1 do
      Owner.Insert(Self, -1).Assign(TOutlookBarItem(Source)[I]);
    OutlookBar.UpdateItem(Self);
  end else inherited Assign(Source);
end;

procedure TOutlookBarItem.Clear;
var
  i:Integer;
begin
  for i := Count - 1 downto 0 do Items[i].Free;
  FItems.Clear;
end;

function TOutlookBarItem.GetPrev: TOutlookBarItem;
begin