aqdockingnative.pas

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

{*******************************************************************}
{                                                                   }
{       AutomatedDocking Library (Cross-Platform Edition)           }
{                                                                   }
{       Copyright (c) 1999-2008 AutomatedQA Corp.                   }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF AUTOMATEDQA CORP. THE REGISTERED DEVELOPER IS        }
{   LICENSED TO DISTRIBUTE THE AUTOMATEDDOCKING LIBRARY AND ALL     }
{   ACCOMPANYING VCL AND CLX CONTROLS AS PART OF AN EXECUTABLE      }
{   PROGRAM ONLY.                                                   }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT WRITTEN CONSENT          }
{   AND PERMISSION FROM AUTOMATEDQA CORP.                           }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit aqDockingNative;

{$I aqDockingVer.inc}

interface

uses
  Classes, Types, aqDockingBase, aqDocking, aqMaskForms, aqDockingUtils;

const
  SNativeDockingStyleName = 'Native';

type
  TaqNativeDocker = class(TaqDocker)
  public
    { TaqDocker }
    function GetDockingRegionType(APoint: TPoint): TaqDockingRegionType; override;
    function GetDockingZoneRgn(ARegion: TaqDockingRegionType): TaqHandle; override;
    function HasDockingZone(ARegion: TaqDockingRegionType): Boolean; override;
    function GetDockingRect(ARegion: TaqDockingRegionType; ADragControl: TaqCustomDockingControl): TRect; override;
    function GetDockingFrameRgn(ARegion: TaqDockingRegionType; ADragControl: TaqCustomDockingControl): TaqHandle; override;
  end;

  TaqNativeMover = class(TaqMover)
  protected
    { TaqMover }
    function FindDockingControl(const Coord: TPoint): TaqCustomDockingControl; override;
    procedure EnterInsideContainer(AContainer: TaqInsideContainer;
      ARegion: TaqDockingRegionType); override;
    procedure LeaveInsideContainer(AContainer: TaqInsideContainer); override;
  end;

  TaqNativeDockingFrame = class(TaqDockingFrame)
  protected
    { TaqCustomDockingFrame }
    function GetMaskFormClass: TaqCustomMaskFormClass; override;
  end;

  TaqNativeDockingStyle = class(TaqDockingStyle)
  protected
    { TaqDockingStyle }
    function GetDockingFrameClass: TaqDockingFrameClass; override;
    function GetMoverClass: TaqMoverClass; override;
    function GetDockerClass(DockClass: TaqCustomDockingControlClass): TaqDockerClass; override;
  end;

  TaqNativeMaskForm = class(TaqMaskForm);

implementation

uses
  SysUtils, Math, 
{$IFDEF VCL}
  Controls, Windows,
{$ELSE}
  QControls,
{$ENDIF}
  aqDockingConst;

type
  TaqCustomDockingSiteFriend = class(TaqCustomDockingSite);
  TaqInsideContainerFriend = class(TaqInsideContainer);
  TaqCustomDockingControlFriend = class(TaqCustomDockingControl);

{ TaqNativeDockingStyle }

function TaqNativeDockingStyle.GetDockerClass(DockClass: TaqCustomDockingControlClass): TaqDockerClass;
begin
  if DockClass.InheritsFrom(TaqWorkspaceControl) then
    Result := TaqWorkspaceDocker
  else if DockClass.InheritsFrom(TaqCustomDockingControl) then
    Result := TaqNativeDocker
  else
    Result := nil;
end;

function TaqNativeDockingStyle.GetDockingFrameClass: TaqDockingFrameClass;
begin
  Result := TaqNativeDockingFrame;
end;

function TaqNativeDockingStyle.GetMoverClass: TaqMoverClass;
begin
  Result := TaqNativeMover;
end;

{ TaqNativeDockingFrame }

function TaqNativeDockingFrame.GetMaskFormClass: TaqCustomMaskFormClass;
begin
  Result := TaqNativeMaskForm;
end;

{ TaqNativeMover }

procedure TaqNativeMover.EnterInsideContainer(AContainer: TaqInsideContainer;
  ARegion: TaqDockingRegionType);
var
  SaveVisible: Boolean;
  Index: Integer;
begin
  if AContainer <> nil then
  begin
    SaveVisible := Frame.Visible;
    Frame.Visible := False;
    Index := AContainer.IndexOf(ActualTarget);
    if ARegion = drtInsideBefore then
      Dec(Index);
    TaqInsideContainerFriend(AContainer).DockTabIndex := Index;
    Frame.Visible := SaveVisible;
  end;
end;

function TaqNativeMover.FindDockingControl(
  const Coord: TPoint): TaqCustomDockingControl;
var
  Control: TControl;
  Handle: TaqHandle;
begin
  with TaqDockingManager(DockingManager) do
    if Customizing then
    begin
      // In customizing mode: restrict docking to main site only.
      if (MainDockSite <> nil) and (MainDockSite.MainItem <> nil) and
        PtInRect(MainDockSite.MainItem.ScreenRect, Coord) then
        Result := MainDockSite.GetItemByPos(Coord)
      else
        Result := nil;
    end
    else
    begin
      Control := {$IFDEF VCL}FindVCLWindow{$ELSE}FindControl{$ENDIF}(Coord);
      while Control <> nil do
      begin
        // Check if we are over splitter.
        if (Control is TaqCustomDockingSite) and
          (TaqCustomDockingSite(Control).DockingManager = DockingManager) then
        begin
          Control := TaqCustomDockingSite(Control).GetItemByPos(Coord);
          Break;
        end
        else if (Control is TaqCustomFloatingForm) and
          (TaqCustomFloatingForm(Control).DockingSite <> nil) and
          (TaqCustomFloatingForm(Control).DockingSite.DockingManager = DockingManager) then
        begin
          Control := TaqCustomFloatingForm(Control).DockingSite.GetItemByPos(Coord);
          Break;
        end
        else if (Control is TaqCustomDockingControl) and
          (TaqCustomDockingControl(Control).DockingManager = DockingManager) then
         Break
        else if Control.Parent <> nil then
          Control := Control.Parent
        else if (Control is TWinControl) and
          (TaqControl(Control).{$IFDEF VCL}ParentWindow{$ELSE}ParentWidget{$ENDIF} <> aqNullHandle) then
        begin
          Handle := TaqControl(Control).{$IFDEF VCL}ParentWindow{$ELSE}ParentWidget{$ENDIF};
          Control := nil;
          while (Control = nil) and (Handle <> aqNullHandle) do
          begin
            Control := FindControl(Handle);
            Handle := aqGetParent(Handle);
          end;
        end
        else
          Control := nil;
      end;
      Result := TaqCustomDockingControl(Control);
    end;
end;

procedure TaqNativeMover.LeaveInsideContainer(AContainer: TaqInsideContainer);
var
  SaveVisible: Boolean;
begin
  if AContainer <> nil then
  begin
    SaveVisible := Frame.Visible;
    Frame.Visible := False;
    TaqInsideContainerFriend(AContainer).DockTabIndex := -2;
    Frame.Visible := SaveVisible;
  end;
end;

{ TaqNativeDocker }

function TaqNativeDocker.GetDockingFrameRgn(ARegion: TaqDockingRegionType;
  ADragControl: TaqCustomDockingControl): TaqHandle;
var
  Rect: TRect;
begin
  Rect := GetDockingRect(ARegion, ADragControl);
  if IsRectEmpty(Rect) then
    Result := aqNullHandle
  else
    Result := CreateRectRgnIndirect(Rect);
end;

function TaqNativeDocker.GetDockingRect(
  ARegion: TaqDockingRegionType; ADragControl: TaqCustomDockingControl): TRect;
var
  InsideRect: TRect;
  P: TPoint;
begin
  if (ManagedItem <> nil) and (ARegion in [drtLeft..drtInside, drtInsideBefore]) then
  begin
    Result := ManagedItem.ScreenRect;
    InsideRect := TaqCustomDockingControlFriend(ManagedItem).GetInsideRect;
    with Result do
    begin
      P.X := (Left + Right) div 2;
      P.Y := (Top + Bottom) div 2;
    end;
    with Result do
      case ARegion of
        drtLeft:
          if Left < InsideRect.Left then
            if ADragControl <> nil then
              Right := Min(Left + ADragControl.ScreenRight - ADragControl.ScreenLeft, P.X)
            else
              Right := P.X;
        drtTop:
          if Top < InsideRect.Top then
            if ADragControl <> nil then
              Bottom := Min(Top + ADragControl.ScreenBottom - ADragControl.ScreenTop, P.Y)
            else
              Bottom := P.Y;
        drtRight:
          if Right > InsideRect.Right then
            if ADragControl <> nil then
              Left := Max(Right - ADragControl.ScreenRight + ADragControl.ScreenLeft, P.X)
            else
              Left := P.X;
        drtBottom:
          if Bottom > InsideRect.Bottom then
            if ADragControl <> nil then
              Top := Max(Bottom - ADragControl.ScreenBottom + ADragControl.ScreenTop, P.Y)
            else
              Top := P.Y;
        drtInside, drtInsideBefore:
          if ManagedItem is TaqInsideContainer then
            TaqCustomDockingControlFriend(ManagedItem).AdjustClientRect(Result);
        else
        begin
          Assert(False);
          Result := Rect(0, 0, 0, 0);
        end;
      end;
  end
  else
    Result := Rect(0, 0, 0, 0);
end;

function TaqNativeDocker.GetDockingRegionType(
  APoint: TPoint): TaqDockingRegionType;
var
  Rect: TRect;
  P: TPoint;
  Index: Integer;
  InsideContainer: TaqInsideContainerFriend;
begin
  Result := drtNone;
  if ManagedItem = nil then
    Exit;

  P := ManagedItem.ScreenToClient(APoint);
  if PtInRect(ManagedItem.ScreenRect, APoint) then
    if (PtInRect(ManagedItem.CaptionRect, P)) or ((ManagedItem is TaqInsideContainer) and
      PtInRect(TaqInsideContainer(ManagedItem).TabAreaRect, P)) then
    begin
      if ManagedItem is TaqInsideContainer then
      begin
        InsideContainer := TaqInsideContainerFriend(ManagedItem);
        Index := InsideContainer.GetTabIndexByCoord(P);
        if Index < 0 then
          Index := InsideContainer.LastVisibleTabIndex;
        if P.X - InsideContainer.TabInfo[Index].Size div 2 <= InsideContainer.TabInfo[Index].Origin then
          Result := drtInsideBefore
        else
          Result := drtInside;
      end
      else
        Result := drtInside;
    end
    else
    begin
      Rect := TaqCustomDockingControlFriend(ManagedItem).GetInsideRect;
      if PtInRect(Rect, APoint) then
        Result := drtInside
      else if APoint.Y <= Rect.Top then
        Result := drtTop
      else if APoint.Y >= Rect.Bottom then
        Result := drtBottom
      else if APoint.X <= Rect.Left then
        Result := drtLeft
      else
        Result := drtRight;
    end
  else if (ManagedItem.Parent <> nil) and
    PtInRect(TaqCustomDockingSiteFriend(ManagedItem.Parent).GetScreenDockZone, APoint) then
    Result := drtInside
  else
    Result := drtNone;
end;

function TaqNativeDocker.GetDockingZoneRgn(
  ARegion: TaqDockingRegionType): TaqHandle;
var
  Rect, InsideRect: TRect;
begin
  if HasDockingZone(ARegion) then
  begin
    Rect := ManagedItem.ScreenRect;
    InsideRect := TaqCustomDockingControlFriend(ManagedItem).GetInsideRect;
    case ARegion of
      drtLeft:
      begin
        Rect.Right := Max(Rect.Left, InsideRect.Left);
        Rect.Top := Max(Rect.Top, InsideRect.Top);
        Rect.Bottom := Min(Rect.Bottom, InsideRect.Bottom);
      end;
      drtTop:
        Rect.Bottom := Max(Rect.Top, InsideRect.Top);
      drtRight:
      begin
        Rect.Left := Min(Rect.Right, InsideRect.Right);
        Rect.Top := Max(Rect.Top, InsideRect.Top);
        Rect.Bottom := Min(Rect.Bottom, InsideRect.Bottom);
      end;
      drtBottom:
        Rect.Top := Min(Rect.Bottom, InsideRect.Bottom);
      drtInside:
        Rect := InsideRect;
      else
        Assert(False);
    end;
    if IsRectEmpty(Rect) then
      Result := 0
    else
      Result := CreateRectRgnIndirect(Rect);
  end
  else
    Result := 0;
end;

function TaqNativeDocker.HasDockingZone(
  ARegion: TaqDockingRegionType): Boolean;
begin
  Result := (ManagedItem <> nil) and (ARegion in [drtLeft..drtInside]);
end;

initialization
  aqDockingStyles.RegisterClass(SNativeDockingStyleName, TaqNativeDockingStyle);
finalization
  aqDockingStyles.UnregisterClass(SNativeDockingStyleName);
end.