aqdocking.pas

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

    function GetDockingFrameClass: TaqDockingFrameClass; virtual; abstract;
    function GetSizerClass(DockClass: TaqCustomDockingControlClass): TaqSizerClass; virtual;
    function GetMoverClass: TaqMoverClass; virtual; abstract;
    function GetDockerClass(DockClass: TaqCustomDockingControlClass): TaqDockerClass; virtual; abstract;
    procedure OnRegisterControl(Control: TaqCustomDockingControl); virtual;
  public
    constructor Create(AOwner: TComponent); virtual;
    procedure Assign(Source: TPersistent); override;

    property DockingManager: TaqDockingManager read FDockingManager;
  published
    property Cursor: TCursor read FCursor write SetCursor default crDefault;
    property TabOrientation: TaqTabOrientation read FTabOrientation write FTabOrientation;
  end;

  TaqHiddenTabInfo = class(TaqTabInfo)
  public
    Control: TaqCustomDockingControl;
    Container: TaqCustomDockingControl;
  end;

  TaqHiddenTabInfoList = class(TObjectList)
  private
    function GetItems(Index: Integer): TaqHiddenTabInfo;
    procedure SetItems(Index: Integer; const Value: TaqHiddenTabInfo);
  public
    property Items[Index: Integer]: TaqHiddenTabInfo read GetItems write SetItems; default;
  end;

  TaqDockingHideZone = class(TObject)
  private
    FTabs: TaqHiddenTabInfoList;
    FDockingSite: TaqDockingSite;
    FItems: TComponentList;
    FOrientation: TaqHideZoneOrientation;
    FPrevNeighbour: TaqDockingHideZone;
    FNextNeighbour: TaqDockingHideZone;
    FHideSite: TaqCustomDockingSite;
    FShowTimer: TTimer;
    FHideTimer: TTimer;
    FShowingTimer: TTimer;
    FHidingTimer: TTimer;
    FItemIndexToShow: Integer;
    FHideSize: Integer;
    FSlideInterval: Byte;
    function GetVisible: Boolean;
    function GetTabHeight: Integer;
    function GetDockingManager: TaqDockingManager;
    function GetControlVisible: Boolean;
    procedure InternalShowControl(AControl: TaqCustomDockingControl;
      AShowing, AImmediately: Boolean);
    procedure HandleMouseActivation(R: TRect; X, Y: Integer; Immediately: Boolean);
    procedure DoShowTimerTimer(Sender: TObject);
    procedure DoHideTimerTimer(Sender: TObject);
    procedure DoShowingTimerTimer(Sender: TObject);
    procedure DoHidingTimerTimer(Sender: TObject);
    procedure StartPendingShow(Index: Integer);
    procedure StartPendingHide;
    procedure DoShow(Index: Integer);
    procedure CancelPendingShow;
    procedure CancelPendingHide;
    procedure CancelPendingShowing;
    procedure CancelPendingHiding;
    procedure Invalidate;
    function GetHiding: Boolean;
    function GetShowing: Boolean;
  protected
    procedure RegisterControl(AControl: TaqCustomDockingControl);
    procedure UnregisterControl(AControl: TaqCustomDockingControl);
    procedure ResetTabs;
    function AddTabs(AControl: TaqCustomDockingControl): TPoint;
    procedure RemoveTabs(AControl: TaqCustomDockingControl);
    procedure CalcHideZone;
    procedure DrawHideZone(Canvas: TCanvas; Rect: TRect);
    function GetGroupIndexes(Control: TaqCustomDockingControl): TPoint; overload;
    function GetGroupIndexes(Index: Integer): TPoint; overload;
    function GetInitialHideSiteSize(AControl: TaqCustomDockingControl): Integer;
    function GetHideSiteSize(MaxValue: Integer): Integer;
    procedure SetInitialHideSiteSize(AControl: TaqCustomDockingControl;
      Value: Integer);
    function GetItemIndex(AControl: TaqCustomDockingControl): Integer; overload;
    function GetItemIndex(Origin: Integer): Integer; overload;

    function GetTabIndent: Integer; virtual; abstract;
    function GetItemRect(R: TRect; Origin, Size, Height: Integer): TRect; virtual; abstract;
    function GetHideSiteBounds: TRect; virtual; abstract;
    function GetItemIndex(R: TRect; X, Y: Integer): Integer; overload; virtual; abstract;
    procedure DoControlResized(Sender: TaqCustomDockingControl); virtual; abstract;
    function GetSplitterSize: Integer; virtual; abstract;

    property DockingManager: TaqDockingManager read GetDockingManager;
    property DockingSite: TaqDockingSite read FDockingSite;
    property HideSite: TaqCustomDockingSite read FHideSite;
  public
    constructor Create(ADockingSite: TaqDockingSite; AOrientation: TaqHideZoneOrientation);
    destructor Destroy; override;

    procedure Clear;
    procedure SetSelectedIndex(Value: Integer);
    function GetClientRect(ARect: TRect): TRect; virtual; abstract;
    procedure AdjustClientRect(var Rect: TRect); virtual; abstract;
    procedure ShowControl(AControl: TaqCustomDockingControl;
      AShowing, AImmediately: Boolean);
    procedure StopAnimate;
    procedure AdjustHideSiteBounds; virtual;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; R: TRect;
      X, Y: Integer);
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; R: TRect;
      X, Y: Integer);
    procedure MouseMove(Shift: TShiftState; R: TRect; X, Y: Integer);
    procedure DoControlChange(Sender: TaqCustomDockingControl;
      Change: TaqDockingControlChange);
    procedure DoActiveControlChange;
    procedure Load(Reader: TaqCustomDockingReader);
    procedure Save(Writer: TaqCustomDockingWriter);

    property Orientation: TaqHideZoneOrientation read FOrientation;
    property SlideInterval: Byte read FSlideInterval write FSlideInterval;
    property Visible: Boolean read GetVisible;
    property PrevNeighbour: TaqDockingHideZone read FPrevNeighbour;
    property NextNeighbour: TaqDockingHideZone read FNextNeighbour;
    property ControlVisible: Boolean read GetControlVisible;
    property Showing: Boolean read GetShowing;
    property Hiding: Boolean read GetHiding;
  end;

  TaqLeftDockingHideZone = class(TaqDockingHideZone)
  protected
    function GetTabIndent: Integer; override;
    function GetItemRect(R: TRect; Origin, Size, Height: Integer): TRect; override;
    function GetItemIndex(R: TRect; X, Y: Integer): Integer; override;
    function GetHideSiteBounds: TRect; override;
    procedure DoControlResized(Sender: TaqCustomDockingControl); override;
    function GetSplitterSize: Integer; override;
  public
    function GetClientRect(ARect: TRect): TRect; override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure AdjustHideSiteBounds; override;
  end;

  TaqTopDockingHideZone = class(TaqDockingHideZone)
  protected
    function GetTabIndent: Integer; override;
    function GetItemRect(R: TRect; Origin, Size, Height: Integer): TRect; override;
    function GetItemIndex(R: TRect; X, Y: Integer): Integer; override;
    function GetHideSiteBounds: TRect; override;
    procedure DoControlResized(Sender: TaqCustomDockingControl); override;
    function GetSplitterSize: Integer; override;
  public
    function GetClientRect(ARect: TRect): TRect; override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure AdjustHideSiteBounds; override;
  end;

  TaqRightDockingHideZone = class(TaqDockingHideZone)
  protected
    function GetTabIndent: Integer; override;
    function GetItemRect(R: TRect; Origin, Size, Height: Integer): TRect; override;
    function GetItemIndex(R: TRect; X, Y: Integer): Integer; override;
    function GetHideSiteBounds: TRect; override;
    procedure DoControlResized(Sender: TaqCustomDockingControl); override;
    function GetSplitterSize: Integer; override;
  public
    function GetClientRect(ARect: TRect): TRect; override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure AdjustHideSiteBounds; override;
  end;

  TaqBottomDockingHideZone = class(TaqDockingHideZone)
  protected
    function GetTabIndent: Integer; override;
    function GetItemRect(R: TRect; Origin, Size, Height: Integer): TRect; override;
    function GetItemIndex(R: TRect; X, Y: Integer): Integer; override;
    function GetHideSiteBounds: TRect; override;
    procedure DoControlResized(Sender: TaqCustomDockingControl); override;
    function GetSplitterSize: Integer; override;
  public
    function GetClientRect(ARect: TRect): TRect; override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure AdjustHideSiteBounds; override;
  end;

  TaqDockingStyleClass = class of TaqDockingStyle;

  TaqDockingSite = class(TaqParentedDockingSite)
  private
    FParentEventsEx: TaqWindowEventFilterEx;
    FWorkspaceControl: TaqCustomDockingControl;
    FHideZones: array [hzoLeft..hzoBottom] of TaqDockingHideZone;
    FAllowAutoHide: TaqOrientations;
    class function FindDockSite(Component: TComponent): TaqDockingSite;
    procedure SetHideZoneNeighbours;
    procedure SetAllowAutoHide(const Value: TaqOrientations);
    procedure ClearHideZones;
    function GetHideZones(Index: TaqHideZoneOrientation): TaqDockingHideZone;
    procedure WorkspaceControlUpdate;
  protected
{$IFDEF VCL}
    procedure CreateWnd; override;
    procedure SetParent(AParent: TWinControl); override;
{$ELSE}
    procedure SetParent(const AParent: TWidgetControl); override;
{$ENDIF}

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ShowControl(AControl: TControl); override;
    procedure AdjustClientRect(var Rect: TRect); 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 Paint; override;
    procedure Resize; override;


{$IFDEF VCL}
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
{$ELSE}
    procedure MouseLeave(AControl: TControl); override;
{$ENDIF}

    { TaqCustomDockingSite }
    procedure RegisterHiddenControl(AControl: TaqCustomDockingControl;
      AOrientation: TaqHideZoneOrientation); override;
    procedure UnregisterHiddenControl(AControl: TaqCustomDockingControl); override;
    procedure ShowDockingControl(AControl: TaqCustomDockingControl;
      Showing: Boolean; Immediately: Boolean = False); override;
    function CanAutoHideItem(AItem: TaqCustomDockingControl): Boolean; override;
    function CanUndoAutoHideItem(AItem: TaqCustomDockingControl): Boolean; override;
    function GetScreenClientRect: TRect; override;
    procedure SetDockingManager(const Value: TaqCustomDockingManager); override;
    procedure UpdateMainTreeItem(AControl: TaqCustomDockingControl); override;
    procedure DoActiveControlChange; override;
    procedure DoControlChange(Sender: TaqCustomDockingControl;
      Change: TaqDockingControlChange); override;
    procedure DoControlResized(Sender: TaqCustomDockingControl); override;
    function BeforeDockingRead: Boolean; override;
    procedure LoadFromStream(Reader: TaqCustomDockingReader); override;
    procedure SaveToStream(Writer: TaqCustomDockingWriter); override;
    procedure PerformSizeConstraintsUpdate; override;
    procedure HandleOleDropActivity(Pos: TPoint; Action: TOleDropAction; var Key: TGUID); override;


    procedure ActiveControlChange;
    procedure AdjustRect(var R: TRect);
    property HideZones[Index: TaqHideZoneOrientation]: TaqDockingHideZone read GetHideZones;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    { TaqCustomDockingSite }
    procedure PerformUpdate; override;
    function GetItemByPos(const Pos: TPoint): TaqCustomDockingControl; override;

    procedure StopAnimate;

    property WorkspaceControl: TaqCustomDockingControl read FWorkspaceControl;
  published
    property Align;
    property AllowAutoHide: TaqOrientations read FAllowAutoHide write SetAllowAutoHide default orAll;
    property Anchors;
    property Color;
    property DockingManager;
    property Font;
    property ParentColor;
    property ParentFont;
    property PopupMenu;

    property OnCanDock;
    property OnCanUndock;
    property OnContextPopup;
    property OnDock;
    property OnUndock;
  end;

  TaqFloatingForm = class(TaqCustomFloatingForm)
  private
    function GetHandle: TaqHandle;
    function CanDesigning: Boolean;
  protected
  {$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
  {$IFDEF DELPHI6}
    procedure WndProc(var Message: TMessage); override;
  {$ENDIF}
  {$ENDIF}
  public
    procedure DoClose(var Action: TCloseAction); override;
    destructor Destroy; override;
  end;

  TaqWorkspaceControl = class(TaqCustomDockingControl)
  protected
    procedure Paint; override;
    function GetShowCaption: TaqBooleanValue; override;
    function GetCaption: string; override;
    procedure DoShow; override;
    procedure DoHide; override;
    procedure DoContextPopup({$IFNDEF VCL}const {$ENDIF}MousePos: TPoint; var Handled: Boolean); override;
    procedure SetDockingManager(const Value: TaqCustomDockingManager); override;
    procedure CreatePopupMenu; override;
    procedure DoEnter; override;
{$IFDEF VCL}
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
{$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;