actnmenus.pas

天涯進銷存系統

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 1995-2002 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit ActnMenus;

interface

uses Windows, Messages, Classes, Forms, Controls, Contnrs, Graphics,
  ActnList, ToolWin, ExtCtrls, ActnMan, ActnCtrls, Menus, StdCtrls,
  ShadowWnd, Buttons, StdActns;

type

{ TMenuStack }

  TCustomActionMenuBar = class;

  TMenuStack = class(TStack)
  private
    FMenu: TCustomActionMenuBar;
    function GetBars(const Index: Integer): TCustomActionMenuBar;
  protected
    property Bars[const Index: Integer]: TCustomActionMenuBar read GetBars;
  public
    constructor Create(AMenu: TCustomActionMenuBar);
    procedure Push(Container: TCustomActionMenuBar);
    function Pop: TCustomActionMenuBar;
    function Peek: TCustomActionMenuBar;
  end;

{ TCustomActionBarStyleEx }

  TCustomPopupClass = class of TCustomActionPopupMenu;
  TCustomAddRemoveItemClass = class of TCustomAddRemoveItem;

  TActionBarStyleEx = class(TActionBarStyle)
    function GetPopupClass(ActionBar: TCustomActionBar): TCustomPopupClass; virtual; abstract;
    function GetAddRemoveItemClass(ActionBar: TCustomActionBar): TCustomAddRemoveItemClass; virtual; abstract;
    function GetScrollBtnClass: TCustomToolScrollBtnClass; virtual; abstract;
  end;

{ TCustomActionMenuBar }

  TAnimationStyle = (asNone, asDefault, asUnFold, asSlide, asFade);
  TMenuPopupEvent = procedure(Sender: TObject;
    Item: TCustomActionControl) of object;
  TCustomActionPopupMenu = class;
  TGetPopupClassEvent = procedure(Sender: TObject;
    var PopupClass: TCustomPopupClass) of object;
  TExitMenuEvent = procedure(Sender: TCustomActionMenuBar; Cancelled: Boolean) of object;

  TCustomActionMenuBar = class(TCustomActionDockBar)
  private
    FAnimatePopups: Boolean;
    FAnimationStyle: TAnimationStyle;
    FCancelMenu: Boolean;
    FDelayItem: TCustomActionControl;
    FDragItem: TCustomActionControl;
    FExpandable: Boolean;
    FExpanded: Boolean;
    FInMenuLoop: Boolean;
    FItemKeyed: Boolean;
    FMouseControl: TControl;
    FMousePos: TPoint;
    FParentForm: TCustomForm;
    FParentMenu: TCustomActionMenuBar;
    FParentControl: TCustomActionControl;
    FPopupStack: TMenuStack;
    FOnPopup: TMenuPopupEvent;
    FExpandDelay: Integer;
    FRootMenu: TCustomActionMenuBar;
    FDefaultFont: Boolean;
    FOnGetPopupClass: TGetPopupClassEvent;
    FAnimateDuration: Integer;
    FOnEnterMenuLoop: TNotifyEvent;
    FOnExitMenuLoop: TExitMenuEvent;
    FUseSystemFont: Boolean;
    procedure WMKeyDown(var Message:  TWMKeyDown); message WM_KEYDOWN;
    procedure CMEnterMenuLoop(var Message: TMessage); message CM_ENTERMENULOOP;
    procedure CMFontchanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMItemClicked(var Message: TCMItemMsg); message CM_ITEMCLICKED;
    procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
    procedure WMSysKeyDown(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN;
    procedure SetParentMenu(const Value: TCustomActionMenuBar);
    procedure CMItemKeyed(var Message: TCMItemMsg); message CM_ITEMKEYED;
    procedure SetAnimateDuration(const Value: Integer);
    procedure DoActionIdle;
    procedure SetMouseControl(const Value: TControl);
    procedure SetUseSystemFont(const Value: Boolean);
  protected
    FSelectedItem: TActionClientItem;  
    FCachedMenu: TCustomActionPopupMenu;
    FChildMenu: TCustomActionMenuBar;
    FExpandTimer: TTimer;
    FPopupTimer: TTimer;
    procedure Animate(Show: Boolean = True);
    procedure Idle(const Msg: TMsg);
    procedure ClearSubMenus;
    procedure CleanupStack;
    function CreateControl(AnItem: TActionClientItem): TCustomActionControl; override;
    function CreatePopup(AOwner: TCustomActionMenuBar;
      Item: TCustomActionControl): TCustomActionPopupMenu; virtual;
    function DoMouseIdle: TControl;
    procedure DoItemSelected(AnItem: TCustomActionControl);
    function DoGetPopupClass: TCustomPopupClass; dynamic;
    function DoItemClicked(AnItem: TCustomActionControl): TActionClientItem; virtual;
    function DoItemKeyed(AnItem: TCustomActionControl): TActionClientItem; virtual;
    procedure DoMenuDelay(Sender: TObject);
    procedure DoneMenuLoop; virtual;
    procedure DoPopup(Item: TCustomActionControl); virtual;
    procedure ExecAction(Action: TContainedAction); virtual;
    procedure Expand(Full: Boolean); virtual;
    procedure ExpandTimer(Sender: TObject);
    procedure GetDefaultSounds; deprecated;
    function GetDesignMode: Boolean; override;
    function GetPopupClass: TCustomPopupClass; virtual;
    function GetMouseHoverItem(Msg: TMsg): TCustomActionControl;
    function GetSelected: TActionClientItem;
    procedure InitMenuLoop; virtual;
    function IsDesignMsg(var Msg: TMsg): Boolean;
    procedure Loaded; override;    
    function NewPopup: TCustomActionPopupMenu; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function ProcessMenuLoop: TActionClientItem; virtual;
    function ProcessMessage(var Msg: TMsg): Boolean;
    procedure ProcessMessages;
    procedure ProcessMouseMsg(var Msg: TMsg); virtual;
    procedure SelectItem(AnItem: TCustomActionControl);
    procedure Select(const Forward: Boolean);
    procedure SetDesignMode(const Value: Boolean); override;
    procedure SetParent(AParent: TWinControl); override;    
    procedure SetPersistentHotkeys(const Value: Boolean); override;
    procedure WndProc(var Message: TMessage); override;
    property AnimateDuration: Integer read FAnimateDuration write SetAnimateDuration;
    property DelayItem: TCustomActionControl read FDelayItem write FDelayItem;
    property Expandable: Boolean read FExpandable write FExpandable;
    property Expanded: Boolean read FExpanded write FExpanded;
    property MouseControl: TControl read FMouseControl write SetMouseControl;
    property ParentMenu: TCustomActionMenuBar read FParentMenu write SetParentMenu;
    property PopupStack: TMenuStack read FPopupStack;
    property Selected: TActionClientItem read GetSelected;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CloseMenu; virtual;
    procedure RecreateControls; override;
    function Style: TActionBarStyle; override;
    procedure TrackMenu; virtual;
    property AnimationStyle: TAnimationStyle read FAnimationStyle write FAnimationStyle;
    property ExpandDelay: Integer read FExpandDelay write FExpandDelay;
    property InMenuLoop: Boolean read FInMenuLoop write FInMenuLoop;
    property ParentControl: TCustomActionControl read FParentControl write FParentControl;
    property RootMenu: TCustomActionMenuBar read FRootMenu write FRootMenu;
    property UseSystemFont: Boolean read FUseSystemFont write SetUseSystemFont;
    property OnEnterMenuLoop: TNotifyEvent read FOnEnterMenuLoop write FOnEnterMenuLoop;
    property OnExitMenuLoop: TExitMenuEvent read FOnExitMenuLoop write FOnExitMenuLoop;
    property OnGetPopupClass: TGetPopupClassEvent read FOnGetPopupClass
      write FOnGetPopupClass;
    property OnPopup: TMenuPopupEvent read FOnPopup write FOnPopup;
  end;

{ TCustomMenuExpandBtn }

  TCustomMenuExpandBtn = class(TCustomUtilityButton)
  private
    function GetMenu: TCustomActionMenuBar;
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
    procedure DrawFrame(ARect: TRect; Down: Boolean); override;
    procedure DragOver(Source: TObject; X: Integer; Y: Integer;
      State: TDragState; var Accept: Boolean); override;
    property Menu: TCustomActionMenuBar read GetMenu;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TCustomActionPopupMenu }

  TCustomMenuItem = class;
  TCustomMenuExpandBtnClass = class of TCustomMenuExpandBtn;

  TCustomActionPopupMenu = class(TCustomActionMenuBar)
  private
    FBShadow: TShadowWindow;
    FExpandBtn: TCustomMenuExpandBtn;
    FRShadow: TShadowWindow;
    FShadow: Boolean;
    procedure SetShadow(const Value: Boolean);
  protected
    procedure AddEdges(AnItem: TCustomMenuItem); virtual;
    procedure DrawBackground; override;
    function CanAutoSize(var NewWidth: Integer;
      var NewHeight: Integer): Boolean; override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMVisibleChanged(var Message: TMessage);
      message CM_VISIBLECHANGED;
    function CreateControl(AnItem: TActionClientItem): TCustomActionControl; override;
    procedure CreateControls; override;
    procedure CreateParams(var Params: TCreateParams); override;
    function DesignWndProc(var Message: TMessage): Boolean; override;
    procedure DisplayShadow; virtual;
    procedure ExecAction(Action: TContainedAction); override;
    procedure ExpandClick(Sender: TObject);
    function GetClientRect: TRect; override;
    function GetExpandBtnClass: TCustomMenuExpandBtnClass; virtual;
    procedure HideShadow; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PositionPopup(AnOwner: TCustomActionBar;
      ParentItem: TCustomActionControl); virtual;
    procedure SetColorMap(const Value: TCustomActionBarColorMap); override;
    procedure SetupExpandBtn;
    procedure SetOrientation(const Value: TBarOrientation); override;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMPrint(var Message: TMessage); message WM_PRINT;
    procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT;
    procedure VisibleChanging; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CloseMenu; override;
    procedure Expand(Full: Boolean); override;
    procedure Popup(X, Y: Integer);
    property ExpandBtn: TCustomMenuExpandBtn read FExpandBtn write FExpandBtn;
    property Shadow: Boolean read FShadow write SetShadow;
  end;

{ TCustomizeActionToolBar }

  TCustomizeActionToolBarClass = class of TCustomizeActionToolBar;

  TCustomizeActionToolBar = class(TCustomActionPopupMenu)
  private
    FActionBar: TCustomActionToolBar;
    FAddlItem: TActionClientItem;
    FResetAction: TCustomAction;
    FResetItem: TActionClientItem;
    procedure CMItemSelected(var Message: TCMItemMsg); message CM_ITEMSELECTED;
  protected
    function CanAutoSize(var NewWidth: Integer;
      var NewHeight: Integer): Boolean; override;
    procedure Clear; override;
    function DoItemClicked(AnItem: TCustomActionControl): TActionClientItem; override;
    function GetAddRemoveItemClass: TCustomAddRemoveItemClass; virtual;
    function GetActionControl(const Index: Integer): TCustomActionControl; override;
    procedure GetSubMenuControlClass(Sender: TCustomActionBar; AnItem: TActionClient;
      var ControlClass: TCustomActionControlClass); virtual;
    function NewPopup: TCustomActionPopupMenu; override;
    procedure SetActionClient(const Value: TActionClient); override;
    property AddlItem: TActionClientItem read FAddlItem;
  public
    constructor Create(AOwner: TComponent); override;
    function ItemCount: Integer; override;
    destructor Destroy; override;
    property AdditionalItem: TActionClientItem read FAddlItem;
  end;

{ TCustomizeActionLink }

  TCustomizeActionLink = class(TActionClientLink)
  protected
    procedure SetEnabled(Value: Boolean); override;
  end;

{ TCustomizeActionClientItem }

  TCustomizeActionClientItem = class(TActionClientItem)
  protected
    function GetActionLinkClass: TActionClientLinkClass; override;
  end;

{ TCustomMDIMenuButton }

  TMDIButtonStyle = (mbMinimize, mbRestore, mbClose);

  TCustomMDIMenuButton = class(TSpeedButton)
  private
    FButtonStyle: TMDIButtonStyle;
  protected
    procedure Paint; override;
  public
    property ButtonStyle: TMDIButtonStyle read FButtonStyle write FButtonStyle;
  end;

{ TCustomActionMainMenuBar }

  TCustomActionMainMenuBar = class(TCustomActionMenuBar)
  private
    FMDIActions: TActionList;
    FMDIActivate: Boolean;
    FInActive: Boolean;
    FShadows: Boolean;
    FWindowMenu: string;
    FMinimizeBtn: TCustomMDIMenuButton;
    FRestoreBtn: TCustomMDIMenuButton;
    FCloseBtn: TCustomMDIMenuButton;
    FMDISeparator: TActionClientItem;
    procedure SetInActive(const Value: Boolean);
    procedure CMEnabledchanged(var Message: TMessage);
      message CM_ENABLEDCHANGED;
    procedure SetWindowMenu(const Value: string);
    procedure SetShadows(const Value: Boolean);
  protected
    FWindowMenuItem: TActionClientItem;
    function CreateControl(AnItem: TActionClientItem): TCustomActionControl; override;
    procedure CreateControls; override;
    procedure CustomAlignPosition(Control: TControl; var NewLeft: Integer;
      var NewTop: Integer; var NewWidth: Integer; var NewHeight: Integer;
      var AlignRect: TRect; AlignInfo: TAlignInfo); override;
    function DesignWndProc(var Message: TMessage): Boolean; override;
    procedure DoneMenuLoop; override;
    procedure GetActiveMDIChild;
    procedure MDIChildMaximized(ChildForm: TCustomForm);
    procedure MDIChildRestored;
    function NewPopup: TCustomActionPopupMenu; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ProcessMouseMsg(var Msg: tagMSG); override;
    procedure RefreshMDIMenu;
    procedure SetDesignMode(const Value: Boolean); override;
    procedure SetupWindowMenu;
    procedure CMWininichange(var Message: TMessage);
      message CM_WININICHANGE;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    procedure WMSysKeyDown(var Message: TWMSysKeyDown);
      message WM_SYSKEYDOWN;
    procedure WMSysKeyUp(var Message: TWMSysKeyUp); message WM_SYSKEYUP;
    function MainWndHook(var Message: TMessage): Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CanFocus: Boolean; override;
    procedure CloseMenu; override;
    procedure TrackMenu; override;
    property Inactive: Boolean read FInActive write SetInActive;
    property PersistentHotKeys;
    property Shadows: Boolean read FShadows write SetShadows default True;
    // Caption of the Window menu item
    property WindowMenu: string read FWindowMenu write SetWindowMenu;
  end;

{ TActionMainMenuBar }

  TActionMainMenuBar = class(TCustomActionMainMenuBar)
  public
    property Canvas;
  published
    property UseSystemFont default True;  
    property ActionManager;
    property Align default alTop;
    property AllowHiding default False;
    property Anchors;
    property AnimateDuration default 150;
    property AnimationStyle default asDefault;
    property BiDiMode default bdLeftToRight;
    property Caption;
    property Color default clBtnFace;
    property ColorMap;
    property Constraints;
    property DragCursor;
    property DragKind default dkDock;
    property DragMode;
    property EdgeBorders default [];
    property EdgeInner default esRaised;
    property EdgeOuter default esLowered;
    property Enabled;
    property ExpandDelay default 4000;
    property Font;
    property HorzMargin;
    property ParentBiDiMode;
    property ParentBackground default False;
    property ParentColor default False;
    property ParentFont default False;
    property ParentShowHint;
    property PersistentHotKeys default False;
    property Shadows;
    property ShowHint;
    property Spacing;
    property VertMargin;
    property Visible;
    property WindowMenu;
    property OnCanResize;
    property OnClick;
    property OnControlCreated;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnEnterMenuLoop;
    property OnExit;
    property OnExitMenuLoop;
    property OnGetControlClass;
    property OnGetPopupClass;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;