aqdockingbase.pas.~6~

AutomatedDocking Library 控件源代码修改 适合Delphi 2009 和C++ Builder 20009 使用。 修正汉字不能正确显示问题

    procedure SetString(const Name: string; const Value: string); override;
    procedure SetPoint(const Name: string; const Value: TPoint); override;
    procedure SetRect(const Name: string; const Value: TRect); override;
    procedure SetGUID(const Name: string; const Value: TGUID); override;
  end;

  TaqDockActionLink = class(TObject)
  private
    FAction: TaqCustomDockAction;
    FOnChange: TNotifyEvent;
    FDoChange: Boolean;
    procedure SetAction(const Value: TaqCustomDockAction);
  protected
    procedure DoChange;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Execute(Sender: TObject);

    property Action: TaqCustomDockAction read FAction write SetAction;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TaqDockActionExecuteEvent = procedure (Sender: TaqCustomDockAction; var DoDefault: Boolean) of object;

  TaqCustomDockAction = class(TComponent)
  private
    FOwner: TaqCustomDockingControl;
    FLinks: TList;
    FEnabled: Boolean;
    FHint: string;
    FCaption: string;
    FOnExecute: TaqDockActionExecuteEvent;
    FOnDefaultExecute: TNotifyEvent;
    FImageIndex: TImageIndex;
    FUpdateCount: Integer;
    FChecked: Boolean;
    FId: TaqActionId;
    FSender: TObject;
    procedure SetCaption(const Value: string);
    procedure SetEnabled(const Value: Boolean);
    procedure SetHint(const Value: string);
    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetChecked(const Value: Boolean);
  protected
    procedure DoChange;
    procedure DoExecute(ASender: TObject);
    procedure AddLink(ALink: TaqDockActionLink);
    procedure RemoveLink(ALink: TaqDockActionLink);

    property OnDefaultExecute: TNotifyEvent read FOnDefaultExecute write FOnDefaultExecute;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    procedure Execute(Sender: TObject);
    procedure BeginUpdate;
    procedure EndUpdate;

    property Caption: string read FCaption write SetCaption;
    property Hint: string read FHint write SetHint;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
    property Checked: Boolean read FChecked write SetChecked;
    property Owner: TaqCustomDockingControl read FOwner;
    property Sender: TObject read FSender;

    property OnExecute: TaqDockActionExecuteEvent read FOnExecute write FOnExecute;
  end;

  TaqDefaultDockAction = class(TaqCustomDockAction)
  private
    FButtonKind: TaqDockButtonKind;
    procedure SetButtonKind(const Value: TaqDockButtonKind);
    procedure ButtonKindChanged;
  public
    constructor Create(AOwner: TComponent; AKind: TaqDockButtonKind); reintroduce;
    procedure Assign(Source: TPersistent); override;

    property ButtonKind: TaqDockButtonKind read FButtonKind write SetButtonKind;
  end;

  TaqCustomButtonDockAction = class(TaqCustomDockAction)
  private
    FButtonIndex: Integer;
  protected
    property ButtonIndex: Integer read FButtonIndex;
  public
    constructor Create(AOwner: TComponent; AButtonIndex: Integer); reintroduce;
  end;

  TaqAlignDockAction = class(TaqCustomDockAction)
  private
    FAlignment: TaqDockingAlignment;
    procedure SetAlignment(const Value: TaqDockingAlignment);
    procedure AlignmentChanged;
  public
    constructor Create(AOwner: TComponent; AAlign: TaqDockingAlignment); reintroduce;
    property Alignment: TaqDockingAlignment read FAlignment write SetAlignment;
  end;

  TaqDockButton = class(TGraphicControl)
  private
    FPressed: Boolean;
    FButtonState: TaqDockButtonState;
    FButtons: TaqDockCaptionButtons;
    FMouseInControl: Boolean;
    FActionLink: TaqDockActionLink;
    procedure SetButtonState(Value: TaqDockButtonState);
    function GetButtons: TaqDockCaptionButtons;
    procedure UpdateTracking;
  protected
    procedure SetAction(const Value: TaqCustomDockAction);
    function GetDockAction: TaqCustomDockAction; virtual;

    procedure DockActionChange(Sender: TObject); virtual;
    procedure Paint; override;
{$IFDEF VCL}
    procedure CMMouseEnter(var message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var message: TMessage); message CM_MOUSELEAVE;
    procedure WMEraseBackground(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
{$ELSE}
    procedure VisibleChanged; override;
    procedure MouseEnter(AControl: TControl); override;
    procedure MouseLeave(AControl: TControl); override;
{$ENDIF}
    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;

    property Buttons: TaqDockCaptionButtons read GetButtons write FButtons;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property ButtonState: TaqDockButtonState read FButtonState write SetButtonState;
    property Action: TaqCustomDockAction read GetDockAction write SetAction;
  end;

  TaqDockCaptionButtons = class(TObject)
  private
    FBounds: TRect;
    FOwner: TaqCustomDockingControl;
    FButtonItems: TaqDockButtonItems;
    FButtons: array [TaqDockButtonKind] of TaqDockButton;
    FPanelState: TaqDockingPanelState;
    FVisible: Boolean;
    FShowDisabled: Boolean;
    FNeedUpdate: Boolean;
    FEvents: TaqApplicationEvents;
    function RelocateButton(AKind: TaqDockButtonKind; APos: Integer): Integer;
    function GetDockingManager: TaqCustomDockingManager;
    function IsKindAllowed(Kind: TaqDockButtonKind): Boolean;
    function GetItem(Kind: TaqDockButtonKind): TaqDockButton;
    function IsButtonVisible(Kind: TaqDockButtonKind): Boolean;
    procedure DoAppActiveChanged(Sender: TObject);
  protected
    procedure SetBounds(const Value: TRect); virtual;
    function GetBounds: TRect; virtual;

    procedure SetVisible(const Value: Boolean); virtual;
    procedure UpdateButtons; virtual;
    procedure InvalidateButtons; virtual;

    property DockingManager: TaqCustomDockingManager read GetDockingManager;
    property Owner: TaqCustomDockingControl read FOwner;
  public
    constructor Create(AOwner: TaqCustomDockingControl); virtual;
    destructor Destroy; override;

    property Visible: Boolean read FVisible write SetVisible;
    property Bounds: TRect read GetBounds write SetBounds;
    property Items[Kind: TaqDockButtonKind]: TaqDockButton read GetItem; default;
  end;

  TaqCaptionDockButton = class(TaqDockButton)
  private
    FVisibleInt: Boolean;
    FPlacement: TaqCustomCaptionButtonPlacement;
    FPosition : TaqCustomCaptionButtonPosition;
    FStyle: TaqCustomCaptionButtonStyle;
    FPicture: TGraphic;

    procedure SetPosition(Value: TaqCustomCaptionButtonPosition);
    procedure SetPlacement(Value: TaqCustomCaptionButtonPlacement);
    procedure SetStyle(Value: TaqCustomCaptionButtonStyle);
    procedure SetButtons(Value: TaqDockCaptionButtonsEx);
    function  GetButtons: TaqDockCaptionButtonsEx;

    function  GetVisible: Boolean;
    procedure SetVisibleInt(const Value: Boolean);
    procedure SetVisible(const Value: Boolean);

    function  GetIndex: Integer;
    procedure SetPicture(Picture: TGraphic);
  protected
    procedure Paint; override;

    property Buttons: TaqDockCaptionButtonsEx read GetButtons write SetButtons;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Picture: TGraphic read FPicture write SetPicture;
    property Placement: TaqCustomCaptionButtonPlacement read FPlacement write SetPlacement;
    property Position: TaqCustomCaptionButtonPosition read FPosition write SetPosition;
    property Style: TaqCustomCaptionButtonStyle read FStyle write SetStyle;
    property Visible: Boolean read GetVisible write SetVisibleInt;
    property Index: Integer read GetIndex;
  end;

  TaqDockCaptionButtonsEx = class(TaqDockCaptionButtons)
  private
    FBoundsEx: TRect;
    FCustomButtons: TComponentList;
    FCustomButtonsParent: TWinControl;
    FContainerBounds: TRect;
    FDefaultButtons: Integer;
    function RelocateCustomButton(Index: Integer; APos: Integer; DestRegion: TRect): Integer;
    function GetButton(Index: Integer): TaqCaptionDockButton;
    function GetCustomButtonsCount: Integer;
    function GetCustomButtonPosition(DefPosition: TaqCustomCaptionButtonPosition): TaqCustomCaptionButtonPosition;
  protected
    function GetBounds: TRect; override;
    procedure SetVisible(const Value: Boolean); override;
    procedure UpdateButtons; override;
    procedure InvalidateButtons; override;
    procedure Update;

    function CustomButtonsParentAssigned: Boolean;
    procedure SetCustomButtonsParent(Value: TWinControl);
    function IsCustomButtonVisible(Index: Integer): Boolean;
    procedure SetContainerBounds(const Value: TRect);

    procedure PrepareDefaultButtons;
    function  AddDefaultButton: TaqCaptionDockButton;

    function  GetButtonIndex(Button: TaqCaptionDockButton): Integer;
//    procedure DoCustomButtonClick(Button: TaqCaptionDockButton; MouseButton: TMouseButton);

    procedure Hide;
    function GetButtonsBounds(ButtonSize: TPoint; Position: TaqCustomCaptionButtonPosition): TPoint;
    property CustomButtonsParent: TWinControl read FCustomButtonsParent write SetCustomButtonsParent;
    property ContainerBounds: TRect read FContainerBounds write SetContainerBounds;
  public
    constructor Create(AOwner: TaqCustomDockingControl); override;
    destructor Destroy; override;

    function  AddCustomButton(Index: Integer = -1): Integer;
    procedure RemoveCustomButton(Index: Integer);

    property CustomButtons[Index: Integer]: TaqCaptionDockButton read GetButton;
    property CustomButtonsCount: Integer read GetCustomButtonsCount;
  end;


  TaqDockMenuItem = class(TMenuItem)
  private
    FActionLink: TaqDockActionLink;
    function GetDockAction: TaqCustomDockAction;
    procedure SetDockAction(const Value: TaqCustomDockAction);
  protected
    procedure DockActionChange(Sender: TObject);
  public
    constructor Create(AOnwer: TComponent); override;
    destructor Destroy; override;

    procedure Click; override;

    property Action: TaqCustomDockAction read GetDockAction write SetDockAction;
  end;

  TaqDockMenu = class(TPopupMenu)
  private
    FOwner: TaqCustomDockingControl;
  public
    constructor Create(AOwner: TComponent); override;