aqdocking.pas

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

    ActiveControl: TGUID;
  end;

  TaqCustomDockingControlFriend = class(TaqCustomDockingControl);
  TaqCustomDockingSiteFriend = class(TaqCustomDockingSite);
  TaqCustomDockActionFriend = class(TaqCustomDockAction);
  TCustomFormFriend = class(TCustomForm);

  TaqNullDockingSite = class(TaqCustomDockingSite)
  protected
    procedure CheckCanDock(AControl: TaqCustomDockingControl); override;
  end;

  TaqAutoHideDockingSite = class(TaqCustomDockingSite)
  private
    FHideZone: TaqDockingHideZone;
    FItem: TaqCustomDockingControl;
  protected
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure PerformSizeConstraintsUpdate; override;

    function GetScreenClientRect: TRect; override;
    procedure CheckCanDock(AControl: TaqCustomDockingControl); override;
    function CanUndockItem(AItem: TaqCustomDockingControl): Boolean; override;
    function GetMainTreeItem: TaqCustomDockingControl; override;
    procedure UpdateMainTreeItem(AControl: TaqCustomDockingControl); override;
    procedure HideMainTreeItem; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure PerformUpdate; override;
    property HideZone: TaqDockingHideZone read FHideZone write FHideZone;
  end;

  TaqDestroyNotifier = class(TaqControl)
  private
    FParentEvents: TaqWindowEventFilter;
    FDockingManager: TaqDockingManager;
    FParentDestroying: Boolean;
    procedure ParentDestroy(Sender: TControl);
    procedure TryFinalize;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor CreateEx(AManager: TaqDockingManager; AParentForm: TCustomForm);
    destructor Destroy; override;
  end;

  TaqEmptyDockingManagerCustomizer = class(TInterfacedObject, IaqDockingManagerCustomizer)
  protected
    { IaqDockingManagerCustomizer }
    procedure EnableParentForms(AEnable: Boolean);
    procedure SelectPanel(AControl: TaqCustomDockingControl; AEdit: Boolean);
    procedure ShowDockingSetup(ADockingManager: TaqDockingManager;
      AShow: Boolean = True; const ActivePage: string = '');
    procedure UpdatePanel(AControl: TaqCustomDockingControl);
    function GetCustomizing: Boolean;
  end;

  TaqDockingStyleList = class(TaqClassList)
  protected
    procedure TryFree(Explicitly: Boolean = True);
    procedure DoUnregister(const ClassName: string; Item: TPersistentClass); override;
  private
    destructor Destroy; override;
  end;

  TaqIntDockingManagerList = class(TaqDockingManagerList)
  protected
    procedure UnregisterDockingManager(AManager: TaqCustomDockingManager); override;
    procedure TryFree(Explicitly: Boolean = True);
  public
    destructor Destroy; override;
  end;

var
  FaqDockingManagers: TaqIntDockingManagerList;
  FaqDockingManagersZombie: Boolean;
  FaqDockingStyles: TaqDockingStyleList;
  FaqDockingStylesZombie: Boolean;
  FaqCustomizer: IaqDockingManagerCustomizer;
  FaqWndProcHookHandle: HHOOK;
  FaqHideZoneMouseHookHandle: HHOOK;
  FaqMouseHookTarget: TaqDockingHideZone;

function aqDockingWndProcHook(Code: Integer; wParam: WParam; lParam: LParam): LRESULT; stdcall;

procedure BDSDesignTimeFix(Control: TWinControl; Visible: Boolean);
var
  i: Integer;
begin
  for i := 0 to Control.ControlCount - 1 do
    if (Control.Controls[i] is TCustomForm) then
    begin
      if Visible then
        aqDockingManagers.DoShowFloatingForms(TCustomForm(Control.Controls[i]))
      else
        aqDockingManagers.DoHideFloatingForms(TCustomForm(Control.Controls[i]));
    end;
end;


var
  AControl: TWinControl;
begin
  Result := CallNextHookEx(FaqWndProcHookHandle, Code, wParam, lParam);
  with PCWPStruct(lParam)^ do
  begin

    case message of
      WM_WINDOWPOSCHANGING:
      begin
        AControl := FindControl(hwnd);
        if (AControl is TCustomForm) and not (AControl is TaqFloatingForm) then
        begin
          if PWindowPos(lParam)^.flags and SWP_HIDEWINDOW <> 0 then
          begin
            {$IFDEF DELPHI9}
            if (aqDockingManagers.Count > 0) and (aqDockingManagers.DockingManagers[0].Designing) then
              BDSDesignTimeFix(AControl, False);
            {$ENDIF}
            aqDockingManagers.DoHideFloatingForms(TCustomForm(AControl));
          end;
        end;
      end;
      WM_WINDOWPOSCHANGED:
      begin
        AControl := FindControl(hwnd);
        if (AControl is TCustomForm) and not (AControl is TaqFloatingForm) then
        begin
          if PWindowPos(lParam)^.flags and SWP_SHOWWINDOW <> 0 then
          begin
            {$IFDEF DELPHI9}
            if (aqDockingManagers.Count > 0) and (aqDockingManagers.DockingManagers[0].Designing) then
              BDSDesignTimeFix(AControl, False);
            {$ENDIF}
            aqDockingManagers.DoShowFloatingForms(TCustomForm(AControl));
          end;
        end;
      end;
    end;
  end;
end;

function aqDockingHideZoneMouseHook(Code: Integer; wParam: WParam; lParam: LParam): LRESULT; stdcall;
var
  Rect: TRect;
  Point: TPoint;
begin
  if (wParam = WM_MOUSEMOVE) then
  begin
    Rect  := FaqMouseHookTarget.GetClientRect(FaqMouseHookTarget.DockingSite.ClientRect);
    Point := FaqMouseHookTarget.DockingSite.ScreenToClient(PMouseHookStruct(lParam)^.pt);
    FaqMouseHookTarget.MouseMove([], Rect, Point.X, Point.Y);
  end;
  Result := CallNextHookEx(FaqHideZoneMouseHookHandle, Code, wParam, lParam);
end;

// Hook mouse movements to perform Auto-Hide when VCL fails to catch WM_MOUSELEAVE
procedure ReleaseAutoHideMouseHook;
begin
{$IFDEF VCL}
  if FaqHideZoneMouseHookHandle <> 0 then
    UnhookWindowsHookEx(FaqHideZoneMouseHookHandle);
  FaqHideZoneMouseHookHandle := 0;
  FaqMouseHookTarget := nil;
{$ENDIF}
end;

procedure SetAutoHideMouseHook(HideZone: TaqDockingHideZone);
begin
{$IFDEF VCL}
  if FaqHideZoneMouseHookHandle <> 0 then
    ReleaseAutoHideMouseHook;
  FaqMouseHookTarget := HideZone;
  FaqHideZoneMouseHookHandle := SetWindowsHookEx(WH_MOUSE, aqDockingHideZoneMouseHook, 0, GetCurrentThreadID);
{$ENDIF}
end;

procedure RegisterCustomizer(
  const ACustomizer: IaqDockingManagerCustomizer);
begin
  FaqCustomizer := ACustomizer;
  if FaqCustomizer = nil then
    FaqCustomizer := TaqEmptyDockingManagerCustomizer.Create;
end;

function aqDockingManagers: TaqDockingManagerList;
begin
  if not FaqDockingManagersZombie and (FaqDockingManagers = nil) then
    FaqDockingManagers := TaqIntDockingManagerList.Create;
  Result := FaqDockingManagers;
end;

function aqDockingStyles: TaqClassList;
begin
  if not FaqDockingStylesZombie and (FaqDockingStyles = nil) then
    FaqDockingStyles := TaqDockingStyleList.Create;
  Result := FaqDockingStyles;
end;

{ private routines }

function GetTopContainer(AControl: TaqCustomDockingControl): TaqCustomDockingControl;
begin
  Result := AControl;
  while Result.ParentItem <> nil do
    Result := Result.ParentItem;
end;

function CompareAlignments(Item1, Item2: Pointer): Integer;
begin
  Result := AlignWeight[TaqCustomDockingControl(Item1).Alignment] -
    AlignWeight[TaqCustomDockingControl(Item2).Alignment];
end;

{ TaqTabInfoList }

function TaqTabInfoList.GetItems(Index: Integer): TaqTabInfo;
begin
  Result := TaqTabInfo(inherited Items[Index]);
end;

procedure TaqTabInfoList.SetItems(Index: Integer; const Value: TaqTabInfo);
begin
  inherited Items[Index] := Value;
end;

procedure TaqTabInfoList.SetDirty(ChildIndex: Integer; Caption: String; ImageIndex: Integer);
var
  i: Integer;
begin

  for i := 0 to Count - 1 do
    if Items[i].Index = ChildIndex then
    begin
      Items[i].Caption :=String(Caption); // zuojin and String
      Items[i].ImageIndex := ImageIndex;
      Items[i].Index := -1;
      break;
    end;
end;

{ TaqHiddenTabInfoList }

function TaqHiddenTabInfoList.GetItems(Index: Integer): TaqHiddenTabInfo;
begin
  Result := TaqHiddenTabInfo(inherited Items[Index]);
end;

procedure TaqHiddenTabInfoList.SetItems(Index: Integer;
  const Value: TaqHiddenTabInfo);
begin
  inherited Items[Index] := Value;
end;

{ TaqSplitContainer }

procedure TaqSplitContainer.ArrangeChildren(StartIndex: Integer; EndIndex: Integer);
var
  Sizer: TaqSplitSizer;
begin
  Sizer := DockingManager.Sizer[TaqCustomDockingContainerClass(DockClass)] as TaqSplitSizer;
  Assert(Sizer <> nil);
  Sizer.ArrangeChildren(Self, StartIndex, EndIndex);
end;

procedure TaqSplitContainer.ArrangeChildren;
begin
  ArrangeChildren(0, ChildCount - 1);
end;

constructor TaqSplitContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHasSplitters := True;
  FSplitterCursor := crDefault;
end;

function TaqSplitContainer.GetSplitterCursor: TCursor;
begin
  Result := inherited GetSplitterCursor;
  if Result = crDefault then
    Result := FSplitterCursor;
end;

{$IFDEF VCL}
procedure TaqSplitContainer.CMVisibleChanged(var Message: TMessage);
{$IFDEF DUMMY} begin end; {$ENDIF}
{$ELSE}
procedure TaqSplitContainer.VisibleChanged;
{$ENDIF}
var
  i: Integer;
begin
  inherited;
  for i := 0 to ChildCount - 1 do
    TaqCustomDockingControlFriend(Children[i]).InternalVisible := InternalVisible;
end;

function TaqSplitContainer.IsValidChildAlignment(
  AAlign: TaqDockingAlignment): Boolean;
begin
  Result := AAlign in [FirstAlign, LastAlign, dalClient];
end;

procedure TaqSplitCon