tb2item.pas

对于单个控件,COMPONET-->INSTALL COMPONENT..-->PAS或DCU文件-->INSTALL。 2.对于带*.DPK文件的控件包,FILE-->OP

    function ScreenToClient(const P: TPoint): TPoint;
  end;
  TTBViewOrientation = (tbvoHorizontal, tbvoVertical, tbvoFloating);
  TTBEnterToolbarLoopOptions = set of (tbetMouseDown, tbetExecuteSelected,
    tbetFromMSAA);
  TTBViewState = set of (vsModal, vsMouseInWindow, vsDrawInOrder, vsOppositePopup,
    vsIgnoreFirstMouseUp, vsShowAccels, vsDropDownMenus, vsNoAnimation);
  TTBViewStyle = set of (vsMenuBar, vsUseHiddenAccels, vsAlwaysShowHints);
  TTBViewTimerID = (tiOpen, tiClose, tiScrollUp, tiScrollDown);

  TTBViewClass = class of TTBView;
  TTBView = class(TComponent)
  private
    FViewers: TList;  { at front to minimize code size }
    FActiveTimers: set of TTBViewTimerID;
    FBackgroundColor: TColor;
    FBaseSize: TPoint;
    FCapture: Boolean;
    FCaptureWnd: HWND;
    FChevronOffset: Integer;
    FChevronParentView: TTBView;
    FChevronSize: Integer;
    FCurParentItem: TTBCustomItem;
    FCustomizing: Boolean;
    FDoneActionData: TTBDoneActionData;
    FInternalViewersAtEnd: Integer;
    FInternalViewersAtFront: Integer;
    FIsPopup: Boolean;
    FIsToolbar: Boolean;
    FMaxHeight: Integer;
    FMonitorRect: TRect;
    FMouseOverSelected: Boolean;
    FNewViewersGetHighestPriority: Boolean;
    FOpenViewer: TTBItemViewer;
    FOpenViewerView: TTBView;
    FOpenViewerWindow: TTBPopupWindow;
    FParentView: TTBView;
    FParentItem: TTBCustomItem;
    FPriorityList: TList;
    FOrientation: TTBViewOrientation;
    FScrollOffset: Integer;
    FSelected: TTBItemViewer;
    FSelectedViaMouse: Boolean;
    FShowDownArrow: Boolean;
    FShowUpArrow: Boolean;
    FState: TTBViewState;
    FStyle: TTBViewStyle;
    FUpdating: Integer;
    FUsePriorityList: Boolean;
    FValidated: Boolean;
    FWindow: TWinControl;
    FWrapOffset: Integer;

    procedure DeletingViewer(Viewer: TTBItemViewer);
    procedure DrawItem(Viewer: TTBItemViewer; DrawTo: TCanvas; Offscreen: Boolean);
    procedure FreeViewers;
    function GetViewer(Index: Integer): TTBItemViewer;
    function GetViewerCount: Integer; {$IFDEF JR_D9} inline; {$ENDIF}
    procedure ImagesChanged;
    function InsertItemViewers(const NewIndex: Integer;
      const AItem: TTBCustomItem; const AGroupLevel: Integer;
      const AddToPriorityList, TopOfPriorityList: Boolean): Integer;
    procedure ItemNotification(Ancestor: TTBCustomItem; Relayed: Boolean;
      Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem);
    procedure LinkNotification(Ancestor: TTBCustomItem; Relayed: Boolean;
      Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem);
    procedure RecreateItemViewer(const I: Integer);
    procedure Scroll(ADown: Boolean);
    procedure SetCustomizing(Value: Boolean);
    procedure SetSelected(Value: TTBItemViewer);
    procedure SetUsePriorityList(Value: Boolean);
    procedure StartTimer(const ATimer: TTBViewTimerID; const Interval: Integer);
    procedure StopAllTimers;
    procedure StopTimer(const ATimer: TTBViewTimerID);
    procedure UpdateCurParentItem;
  protected
    FAccObjectInstance: TTBBaseAccObject;
    procedure AutoSize(AWidth, AHeight: Integer); virtual;
    function CalculatePositions(const CanMoveControls: Boolean;
      const AOrientation: TTBViewOrientation;
      AWrapOffset, AChevronOffset, AChevronSize: Integer;
      var ABaseSize, TotalSize: TPoint;
      var AWrappedLines: Integer): Boolean;
    procedure DoUpdatePositions(var ASize: TPoint); virtual;
    function GetChevronItem: TTBCustomItem; virtual;
    procedure GetMargins(AOrientation: TTBViewOrientation; var Margins: TRect);
      virtual;
    function GetMDIButtonsItem: TTBCustomItem; virtual;
    function GetMDISystemMenuItem: TTBCustomItem; virtual;
    function GetParentToolbarView: TTBView;
    function GetRootView: TTBView;
    function HandleWMGetObject(var Message: TMessage): Boolean;
    procedure InitiateActions;
    procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetAccelsVisibility(AShowAccels: Boolean);
  public
    constructor Create(AOwner: TComponent; AParentView: TTBView;
      AParentItem: TTBCustomItem; AWindow: TWinControl;
      AIsToolbar, ACustomizing, AUsePriorityList: Boolean); reintroduce; virtual;
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure CancelCapture;
    procedure CancelChildPopups;
    procedure CancelMode;
    procedure CloseChildPopups;
    function ContainsView(AView: TTBView): Boolean;
    procedure DrawSubitems(ACanvas: TCanvas);
    procedure EndModal;
    procedure EndModalWithClick(AViewer: TTBItemViewer);
    procedure EndModalWithHelp(AContextID: Integer);
    procedure EndModalWithSystemMenu(AWnd: HWND; AKey: Cardinal);
    procedure EndUpdate;
    procedure EnterToolbarLoop(Options: TTBEnterToolbarLoopOptions);
    procedure ExecuteSelected(AGivePriority: Boolean);
    function Find(Item: TTBCustomItem): TTBItemViewer;
    function FirstSelectable: TTBItemViewer;
    function GetAccObject: TTBBaseAccObject;
    function GetCaptureWnd: HWND;
    function GetFont: TFont; virtual;
    procedure GetOffEdgeControlList(const List: TList);
    procedure GivePriority(AViewer: TTBItemViewer);
    procedure HandleHintShowMessage(var Message: TCMHintShow);
    function HighestPriorityViewer: TTBItemViewer;
    procedure Invalidate(AViewer: TTBItemViewer);
    procedure InvalidatePositions; virtual;
    function IndexOf(AViewer: TTBItemViewer): Integer;
    function IsModalEnding: Boolean;
    function NextSelectable(CurViewer: TTBItemViewer; GoForward: Boolean): TTBItemViewer;
    function NextSelectableWithAccel(CurViewer: TTBItemViewer; Key: Char;
      RequirePrimaryAccel: Boolean; var IsOnlyItemWithAccel: Boolean): TTBItemViewer;
    procedure NotifyFocusEvent;
    function OpenChildPopup(const SelectFirstItem: Boolean): Boolean;
    procedure RecreateAllViewers;
    procedure ScrollSelectedIntoView;
    procedure Select(Value: TTBItemViewer; ViaMouse: Boolean);
    procedure SetCapture;
    procedure TryValidatePositions;
    procedure UpdateSelection(const P: TPoint; const AllowNewSelection: Boolean);
    function UpdatePositions: TPoint;
    procedure ValidatePositions;
    function ViewerFromPoint(const P: TPoint): TTBItemViewer;

    property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor;
    property BaseSize: TPoint read FBaseSize;
    property Capture: Boolean read FCapture;
    property ChevronOffset: Integer read FChevronOffset write FChevronOffset;
    property ChevronSize: Integer read FChevronSize write FChevronSize;
    property Customizing: Boolean read FCustomizing write SetCustomizing;
    property IsPopup: Boolean read FIsPopup;
    property IsToolbar: Boolean read FIsToolbar;
    property MouseOverSelected: Boolean read FMouseOverSelected;
    property NewViewersGetHighestPriority: Boolean read FNewViewersGetHighestPriority
      write FNewViewersGetHighestPriority;
    property ParentView: TTBView read FParentView;
    property ParentItem: TTBCustomItem read FParentItem;
    property OpenViewer: TTBItemViewer read FOpenViewer;
    property OpenViewerView: TTBView read FOpenViewerView;
    property Orientation: TTBViewOrientation read FOrientation write FOrientation;
    property Selected: TTBItemViewer read FSelected write SetSelected;
    property SelectedViaMouse: Boolean read FSelectedViaMouse;
    property State: TTBViewState read FState;
    property Style: TTBViewStyle read FStyle write FStyle;
    property UsePriorityList: Boolean read FUsePriorityList write SetUsePriorityList;
    property Viewers[Index: Integer]: TTBItemViewer read GetViewer;
    property ViewerCount: Integer read GetViewerCount;
    property Window: TWinControl read FWindow;
    property WrapOffset: Integer read FWrapOffset write FWrapOffset;
  end;

  TTBRootItemClass = class of TTBRootItem;
  TTBRootItem = class(TTBCustomItem);
  { same as TTBCustomItem, except there's a property editor for it }

  TTBItem = class(TTBCustomItem)
  published
    property Action;
    property AutoCheck;
    property Caption;
    property Checked;
    property DisplayMode;
    property Enabled;
    property GroupIndex;
    property HelpContext;
    property Hint;
    property ImageIndex;
    property Images;
    property InheritOptions;
    property MaskOptions;
    property Options;
    property RadioItem;
    property ShortCut;
    property Visible;

    property OnClick;
    property OnSelect;
  end;

  TTBGroupItem = class(TTBCustomItem)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property InheritOptions;
    property LinkSubitems;
    property MaskOptions;
    property Options;
  end;

  TTBSubmenuItem = class(TTBCustomItem)
  private
    function GetDropdownCombo: Boolean;
    procedure SetDropdownCombo(Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Action;
    property AutoCheck;
    property Caption;
    property Checked;
    //property DisplayAsToolbar;
    property DisplayMode;
    property DropdownCombo: Boolean read GetDropdownCombo write SetDropdownCombo default False;
    property Enabled;
    property GroupIndex;
    property HelpContext;
    property Hint;
    property ImageIndex;
    property Images;
    property InheritOptions;
    property LinkSubitems;
    property MaskOptions;
    property Options;
    property RadioItem;
    property ShortCut;
    property SubMenuImages;
    property Visible;

    property OnClick;
    property OnPopup;
    property OnSelect;
  end;

  TTBSeparatorItem = class(TTBCustomItem)
  private
    FBlank: Boolean;
    procedure SetBlank(Value: Boolean);
  protected
    function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Blank: Boolean read FBlank write SetBlank default False;
    property Hint;
    property Visible;
  end;

  TTBSeparatorItemViewer = class(TTBItemViewer)
  protected
    procedure CalcSize(const Canvas: TCanvas;
      var AWidth, AHeight: Integer); override;
    procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect;
      IsSelected, IsPushed, UseDisabledShadow: Boolean); override;
    function UsesSameWidth: Boolean; override;
  end;

  TTBControlItem = class(TTBCustomItem)
  private
    FControl: TControl;
    FDontFreeControl: Boolean;
    procedure SetControl(Value: TControl);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property DontFreeControl: Boolean read FDontFreeControl write FDontFreeControl;
  published
    property Control: TControl read FControl write SetControl;
  end;

  TTBPopupView = class(TTBView)
  protected
    procedure AutoSize(AWidth, AHeight: Integer); override;
  public
    function GetFont: TFont; override;
  end;

  ITBPopupWindow = interface
    ['{E45CBE74-1ECF-44CB-B064-6D45B1924708}']
  end;

  TTBPopupWindow = class(TCustomControl, ITBPopupWindow)
  private
    FAccelsVisibilitySet: Boolean;
    FAnimationDirection: TTBAnimationDirection;
    FView: TTBView;
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure WMClose(var Message: TWMClose); message WM_CLOSE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMPrint(var Message: TMessage); message WM_PRINT;
    procedure WMPrintClient(var Message: {$IFNDEF CLR} TMessage {$ELSE} TWMPrintClient {$ENDIF}); message WM_PRINTCLIENT;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWindowHandle; override;
    function GetViewClass: TTBViewClass; dynamic;
    procedure Paint; override;
    procedure PaintScrollArrows; virtual;
  public
    //fsd
    BK:Tbitmap;
    constructor CreatePopupWindow(AOwner: TComponent; const AParentView: TTBView;
      const AItem: TTBCustomItem; const ACustomizing: Boolean); virtual;
    destructor Destroy; override;

    property View: TTBView read FView;
  end;

  ITBItems = interface
    ['{A5C0D7CC-3EC4-4090-A0F8-3D03271877EA}']
    function GetItems: TTBCustomItem;
  end;

  TTBItemContainer = class(TComponent, ITBItems)
  private
    FItem: TTBRootItem;
    function GetImages: TCustomImageList;
    function GetItems: TTBCustomItem;
    procedure SetImages(Value: TCustomImageList);
  protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Items: TTBRootItem read FItem;
  published
    property Images: TCustomImageList read GetImages write SetImages;
  end;

  TTBPopupMenu = class(TPopupMenu, ITBItems)
  private
    FItem: TTBRootItem;
    //procedure SetItems(Value: TTBCustomItem);
    function GetImages: TCustomImageList;
    function GetItems: TTBCustomItem;
    function GetLinkSubitems: TTBCustomItem;
    function GetOptions: TTBItemOptions;
    procedure RootItemClick(Sender: TObject);
    procedure SetImages(Value: TCustomImageList);
    procedure SetLinkSubitems(Value: TTBCustomItem);
    procedure SetOptions(Value: TTBItemOptions);
  protected
    {$IFNDEF JR_D5}
    procedure DoPopup(Sender: TObject);
    {$ENDIF}
    {$IFNDEF CLR}
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    {$ENDIF}
    function GetRootItemClass: TTBRootItemClass; dynamic;
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {$IFDEF CLR}
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    {$ENDIF}
    function IsShortCut(var Message: TWMKey): Boolean; override;