aoutlbar.pas

来自「delphi编程控件」· PAS 代码 · 共 2,084 行 · 第 1/5 页

unit aoutlbar;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)

{$I aclver.inc}

interface
uses Classes, Controls, Windows, SysUtils, ExtCtrls, Graphics, Buttons,
StdCtrls, Forms, Messages, Menus, CommCtrl{$IFDEF DELPHI4}, ImgList{$ENDIF};

type
TAutoOutLookBarStore = class;
TAutoOutLookItem = class;

TAutoOutLookBarItemClickEvent = procedure(Sender : TObject; Item : TAutoOutLookItem) of object;

TAutoOutLookStoredItem = class(TComponent)
private
  FCategory : Integer;
  FCaption : String;
  FHint : String;
  FLargeImage : Integer;
  FSmallImage : Integer;
  FOnClick : TAutoOutLookBarItemClickEvent;
  FStore : TAutoOutLookBarStore;
  FPopupMenu : TPopupMenu;

  procedure SetCaption(Value : String);
  procedure SetCategory(Value : Integer);
  procedure SetHint(Value : String);
  procedure SetLargeImage(Value : Integer);
  procedure SetSmallImage(Value : Integer);
  procedure SetStore(Value : TAutoOutLookBarStore);
protected
  procedure DoClick(Sender : TObject; Item : TAutoOutLookItem);
  procedure ReadState(Reader: TReader); override;
  procedure SetParentComponent(AParent: TComponent); override;
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  function GetParentComponent : TComponent; override;
  function HasParent: Boolean; override;
  property Store : TAutoOutLookBarStore read FStore write SetStore;
published
  property Caption : String read FCaption write SetCaption;
  property Category : Integer read FCategory write SetCategory;
  property Hint : String read FHint write SetHint;
  property LargeImage : Integer read FLargeImage write SetLargeImage;
  property SmallImage : Integer read FSmallImage write SetSmallImage;
  property PopupMenu : TPopupMenu read FPopupMenu write FPopupMenu;
  property OnClick : TAutoOutLookBarItemClickEvent read FOnClick write FOnClick;
end;

TAutoOutLookBar = class;

TAutoOutLookBarStore = class(TComponent)
private
  FList : TList;
  FBars : TList;
  FCategories : TStrings;
  FLargeImages : TImageList;
  FSmallImages : TImageList;
  FChangeLink : TChangeLink;
  FDefaultLargeImage : Integer;
  FDefaultSmallImage : Integer;

  function GetCount : Integer;
  function GetOutLookBarCount : Integer;
  function GetItem(Index : Integer) : TAutoOutLookStoredItem;
  function GetOutLookBar(Index : Integer) : TAutoOutLookBar;
  procedure SetCategories(Value : TStrings);
  procedure SetDefaultLargeImage(Value : Integer);
  procedure SetDefaultSmallImage(Value : Integer);
  procedure SetLargeImages(Value : TImageList);
  procedure SetSmallImages(Value : TImageList);
  procedure DestroyItems;
  procedure OnChangeLink(Sender : TObject);
  procedure RedrawBars;
  procedure RemoveBarItem(StoredItem : TAutoOutLookStoredItem);
protected
{$IFDEF DELPHI3_0}
   procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
{$ELSE}
   procedure GetChildren(Proc: TGetChildProc); override;
{$ENDIF}
   procedure SetName(const Value: TComponentName); override;
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
public
  Designer : Pointer;

  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure AddItem(Item : TAutoOutLookStoredItem);
  procedure ExchangeItems(Item1, Item2 : TAutoOutLookStoredItem);
  procedure RemoveItem(Item : TAutoOutLookStoredItem);
  procedure UpdateItem(Item : TAutoOutLookStoredItem);
  function GetCountByCategory(St : String) : Integer;
  function GetItemByCategory(St : String; Index : Integer) : TAutoOutLookStoredItem;
  function GetItemsByCategory(St : String; List : TList) : Integer;
  procedure Customize;
  {$IFDEF INCLUDE_DESIGNTIME}
  procedure UpdateEditorItem(Item : TAutoOutLookStoredItem);
  {$ENDIF}
  property Count : Integer read GetCount;
  property Items[Index : Integer] : TAutoOutLookStoredItem read GetItem;
  property OutLookBarCount : Integer read GetOutLookBarCount;
  property OutLookBars[Index : Integer] : TAutoOutLookBar read GetOutLookBar;
published
  property Categories : TStrings read FCategories write SetCategories;
  property DefaultLargeImage : Integer read FDefaultLargeImage write SetDefaultLargeImage;
  property DefaultSmallImage : Integer read FDefaultSmallImage write SetDefaultSmallImage;
  property LargeImages : TImageList read FLargeImages write SetLargeImages;
  property SmallImages : TImageList read FSmallImages write SetSmallImages;
end;

TAutoOutLookGroups = class;
TAutoOutLookGroup = class;
TAutoOutLookItems = class;

TAutoOutLookItem = class(TCollectionItem)
private
  FCaption : String;
  FIsDefault : Boolean;
  FLargeImage : Integer;
  FSmallImage : Integer;
  FStoredItem : TAutoOutLookStoredItem;
  FTextHeight : Integer;
  FVisible : Boolean;
  FPartialVisible : Boolean;
  FCustomData : String;
  FHint : String;
  FObject : TObject;
  FTag : LongInt;

  function GetCaption : String;
  function GetHint : String;
  function GetGroup : TAutoOutLookGroup;
  function GetLargeImage : Integer;
  function GetSmallImage : Integer;
  procedure SetCaption(Value : String);
  procedure SetHint(Value : String);
  procedure SetIsDefault(Value : Boolean);
  procedure SetLargeImage(Value : Integer);
  procedure SetSmallImage(Value : Integer);
  procedure SetStoredItem(Value : TAutoOutLookStoredItem);
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;
  function MakeVisible : Boolean;

  property Group : TAutoOutLookGroup read GetGroup;
  property ItemObject : TObject read FObject write FObject;
  property Visible : Boolean read FVisible;  
published
  property Caption : String read GetCaption write SetCaption;
  property CustomData : String read FCustomData write FCustomData;
  property Hint : String read GetHint write SetHint;
  property Index;
  property IsDefault : Boolean read FIsDefault write SetIsDefault;
  property LargeImage : Integer read GetLargeImage write SetLargeImage;
  property SmallImage : Integer read GetSmallImage write SetSmallImage;
  property StoredItem : TAutoOutLookStoredItem read FStoredItem write SetStoredItem;
  property Tag : LongInt read FTag write FTag;
end;

TAutoOutLookItems = class(TCollection)
private
  Group : TAutoOutLookGroup;
  AutoOutLookBar : TAutoOutLookBar;

  function GetItem(Index : Integer) : TAutoOutLookItem;
  procedure SetItem(Index : Integer; Value : TAutoOutLookItem);
protected
  procedure Update(Item: TCollectionItem); override;
public
  constructor Create(AOwner : TAutoOutLookGroup);

  function Add : TAutoOutLookItem;
  property Items[Index : Integer] : TAutoOutLookItem read GetItem write SetItem; default;
end;

TAutoOutLookGroupIconType = (aotLargeIcon, aotSmallIcon);

TAutoOutLookGroup = class(TCollectionItem)
private
  FItems : TAutoOutLookItems;
  FTopVisibleItem : Integer;
  FCaption : String;
  FIconType : TAutoOutLookGroupIconType;
  FIsAssigning : Boolean;

  function GetActive : Boolean;
  function GetItemCount : Integer;
  procedure SetCaption(Value : String);
  procedure SetIconType(Value : TAutoOutLookGroupIconType);
  procedure SetItems(Value : TAutoOutLookItems);
  procedure SetTopVisibleItem(Value : Integer);
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;
  procedure MakeActive;
  function GetVisibleCount : Integer;

  property Active : Boolean read GetActive;
  property ItemCount : Integer read GetItemCount; 
  property TopVisibleItem : Integer read FTopVisibleItem write SetTopVisibleItem;
published
  property Caption : String read FCaption write SetCaption;
  property Index;
  property IconType : TAutoOutLookGroupIconType read FIconType write SetIconType;
  property Items : TAutoOutLookItems read FItems write SetItems;
end;

TAutoOutLookGroups = class(TCollection)
private
  AutoOutLookBar : TAutoOutLookBar;

  function GetItem(Index : Integer) : TAutoOutLookGroup;
  procedure SetItem(Index : Integer; Value : TAutoOutLookGroup);
protected
  procedure Update(Item: TCollectionItem); override;
public
  constructor Create(AOwner : TAutoOutLookBar);

  function Add : TAutoOutLookGroup;
  property Items[Index : Integer] : TAutoOutLookGroup read GetItem write SetItem; default;
end;

TAutoOutLookBarChangeGroupCaptionEvent = procedure(Sender : TObject; Group : TAutoOutLookGroup) of object;
TAutoOutLookBarDragDropItemEvent = procedure(Sender : TObject; Source, Target : TAutoOutLookItem;
                                 IsCopy : Boolean) of object;
TAutoOutLookBarDeleteItemEvent = procedure(Sender : TObject; Item : TAutoOutLookItem) of object;

TAutoOutLookBarFillStyle = (bfsNone, bfsHorz, bfsVert);

TAutoOutLookBarBackGround = class(TPersistent)
private
  FBeginColor : TColor;
  FEndColor : TColor;
  FOnChange : TNotifyEvent;
  FFillStyle : TAutoOutLookBarFillStyle;

  procedure SetBeginColor(Value : TColor);
  procedure SetEndColor(Value : TColor);
  procedure SetFillStyle(Value : TAutoOutLookBarFillStyle);
  procedure DoChange;
public
  constructor Create;
  function IsUsed : Boolean; 
  property OnChange : TNotifyEvent read FOnChange write FOnChange;
published
  property BeginColor : TColor read FBeginColor write SetBeginColor;
  property EndColor : TColor read FEndColor write SetEndColor;
  property FillStyle : TAutoOutLookBarFillStyle read FFillStyle write SetFillStyle;
end;

TAutoOutLookBar = class(TCustomPanel)
private
  FActiveGroupIndex : Integer;
  FOldActiveGroupIndex : Integer;
  FActiveGroup : TAutoOutLookGroup;
  FGroups : TAutoOutLookGroups;
  FStore : TAutoOutLookBarStore;
  FGroupFont : TFont;
  FItemFont : TFont;
  FRenameGroup : TAutoOutLookGroup;
  FRenameItem : TAutoOutLookItem;
  FRenameEdit : TEdit;
  FCanSelected : Boolean;
  FHintWindow : THintWindow;
  FHintWindowShowing : Boolean;
  FHintTimerID : Integer;  
  FSelectedItem : TAutoOutLookItem;
  FOnDeleteItem : TAutoOutLookBarDeleteItemEvent;
  FOnChangeActiveGroup : TNotifyEvent;
  FOnChangeFocusedItem : TNotifyEvent;
  FOnChangeSelectedItem : TNotifyEvent;
  FOnChangeGroupCaption : TAutoOutLookBarChangeGroupCaptionEvent;
  FSpaceHeight : Integer;
  FScrollDelay : Integer;
  FScrollButtonUpIsVisible : Boolean;
  FScrollButtonUpIsDown : Boolean;
  FScrollButtonDownIsVisible : Boolean;
  FScrollButtonDownIsDown : Boolean;
  FScrollTimerID : Integer;
  FGroupHeight : Integer;
  FItemHeight : Integer;
  FPaintRect : TRect;
  FMouseFocusedItem : TAutoOutLookItem;
  FMouseFocusedItemIsDown : Boolean;
  FCanvasDC : HDC;
  FDestDropItemIndex : TAutoOutLookItem;
  FIsDropBottom : Boolean;
  FEnableDraging : Boolean;
  FDragMode : TDragMode;
  FPointDragging : TPoint;
  FGroupPopupMenu : TPopupMenu;
  FItemPopupMenu : TPopupMenu;
  FTransparentImages : Boolean;
  FImageList : TImageList;
  FAssignFlag : Boolean;
  FOnMouseEnter : TNotifyEvent;
  FOnMouseLeave : TNotifyEvent;
  FOnAfterEdit : TNotifyEvent;
  FOnBeforeEdit : TNotifyEvent;
  FOnDragDropItem : TAutoOutLookBarDragDropItemEvent;
  FOnItemClick : TAutoOutLookBarItemClickEvent;
  FBkPicture : TPicture;
  FBkGround : TAutoOutLookBarBackGround;

  function GetGroupCount : Integer;
  procedure SetActiveGroup(Value : TAutoOutLookGroup);
  procedure SetActiveGroupIndex(Value : Integer);
  procedure SetBkGround(Value : TAutoOutLookBarBackGround);
  procedure SetBkPicture(Value : TPicture);
  procedure SetCanSelected(Value : Boolean);
  procedure SetGroupFont(Value : TFont);
  procedure SetGroups(Value : TAutoOutLookGroups);
  procedure SetItemFont(Value : TFont);
  procedure SetScrollDelay(Value : Integer);
  procedure SetSpaceHeight(Value : Integer);
  procedure SetStore(Value : TAutoOutLookBarStore);
  procedure SetTransparentImages(Value : Boolean);
  procedure SetDestDropItemIndex(Value : TAutoOutLookItem);
  procedure SetIsDropBottom(Value : Boolean);
  procedure SetDestDropItemIndex_(Value1 : TAutoOutLookItem; Value2 : Boolean);
  procedure SetMouseFocusedItem(Item : TAutoOutLookItem);
  procedure SetSelectedItem(Item : TAutoOutLookItem);

  procedure DrawGroup(Index : Integer);
  procedure DrawTopGroups;
  procedure DrawBottomGroups;
  procedure DrawItems;
  procedure DrawItem(Index : Integer);
  function DrawItemImage(Index : Integer) : Boolean;
  function DrawItemText(Index : Integer) : Boolean;
  procedure DrawScrollButtons;
  procedure DrawFillRect(ARect : TRect);
  procedure HintActivate(AShow : Boolean);
  procedure MakeGroupScrolling;
  function GetFontHeight(AFont : TFont) : Integer;
  function GetGroupHeight : Integer;
  function GetItemHeight : Integer;
  function GetGroupRect(Index : Integer) : TRect;
  function GetTopFirstBottomGroup : Integer;
  function GetItemTop(Index : Integer) : Integer;
  function GetItemImageRect(Index : Integer) : TRect;
  function GetItemTextRect(Index : Integer; St : String) : TRect;
  function GetItemPaintedImageRect(Index : Integer) : TRect;
  function GetDrawItemTextHeight(St : String; r : TRect) : Integer;
  function GetTopVisibleToMakeItemVisible(Index : Integer) : Integer;
  function GetPaintRect : TRect;
  function GetLargeImageHeight : Integer;
  function GetLargeImageWidth : Integer;
  function GetSmallImageHeight : Integer;
  function GetSmallImageWidth : Integer;

  function GetFocusedItem(X, Y : Integer) : TAutoOutLookItem;
  function GetSpacedItem(X, Y : Integer) : Integer;
  function GetItemBottomSpace(Item : Integer) : TPoint;

  procedure RenameEditExit(Sender: TObject);
  procedure DoItemMouseFocused(Item : TAutoOutLookItem; IsDown : Boolean);
  procedure DoItemSelected(Item : TAutoOutLookItem);
  procedure DoBkPictureChange(Sender : TObject);  
  procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
protected
  procedure Paint; override;
  procedure WndProc(var Message : TMessage); override;
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  procedure DoItemClick(Item : TAutoOutLookItem); virtual;
  procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
    var Accept: Boolean); override;
  procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
  procedure DoStartDrag(var DragObject: TDragObject); override;

  property DestDropItemIndex : TAutoOutLookItem read FDestDropItemIndex write SetDestDropItemIndex;
  property IsDropBottom : Boolean read FIsDropBottom write SetIsDropBottom;
public
  IsMakingUpdate : Boolean;

  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;

  procedure Assign(Source: TPersistent); override;
  function GetGroupAtPos(p : TPoint) : TAutoOutLookGroup;
  function GetItemAtPos(p : TPoint) : TAutoOutLookItem;
  function GetPopupGroup : TAutoOutLookGroup;
  function IsGroupEditing : Boolean;
  function IsItemEditing : Boolean;
  function IsEditing : Boolean;
  procedure EditGroup(Group : TAutoOutLookGroup);
  procedure EditItem(Item : TAutoOutLookItem);
  procedure EndEdit(Accept : Boolean);

  property ActiveGroup : TAutoOutLookGroup read FActiveGroup write SetActiveGroup;
  property EditControl : TEdit read FRenameEdit;
  property EditingGroup : TAutoOutLookGroup read FRenameGroup;
  property EditingItem : TAutoOutLookItem read FRenameItem;
  property FocusedItem : TAutoOutLookItem read FMouseFocusedItem;
  property GroupCount : Integer read GetGroupCount;
  property SelectedItem : TAutoOutLookItem read FSelectedItem write DoItemSelected;
published