⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 aqdockingvs2005.pas

📁 AutomatedDocking Library 控件源代码修改 适合Delphi 2009 和C++ Builder 20009 使用。 修正汉字不能正确显示问题
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      Right := Min(Left + DefaultTabSize, Right);
    end;
    Result := ExtCreateRegion(nil, RegionDataSize, Polygon^);
    FreeMem(Polygon);
  end
  else
    Result := CreateRectRgnIndirect(Rect);
end;

function TaqVS2005Docker.GetDockingRect(
  ARegion: TaqDockingRegionType; ADragControl: TaqCustomDockingControl): TRect;
var
  InsideRect: TRect;
  Control: TaqCustomDockingControlFriend;
  P: TPoint;
begin
  if (ManagedItem <> nil) and (ARegion <> drtNone) then
  begin
    Control := TaqCustomDockingControlFriend(ManagedItem);
    Result := Control.ScreenRect;
    InsideRect := Control.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, drtDetachedLeft:
          if Left < InsideRect.Left then
            if ADragControl <> nil then
              Right := Min(Left + ADragControl.ScreenRight - ADragControl.ScreenLeft, P.X)
            else
              Right := P.X;
        drtTop, drtDetachedTop:
          if Top < InsideRect.Top then
            if ADragControl <> nil then
              Bottom := Min(Top + ADragControl.ScreenBottom - ADragControl.ScreenTop, P.Y)
            else
              Bottom := P.Y;
        drtRight, drtDetachedRight:
          if Right > InsideRect.Right then
            if ADragControl <> nil then
              Left := Max(Right - ADragControl.ScreenRight + ADragControl.ScreenLeft, P.X)
            else
              Left := P.X;
        drtBottom, drtDetachedBottom:
          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 TaqVS2005Docker.GetDockingRegionType(
  APoint: TPoint): TaqDockingRegionType;
var
  Region: TaqHandle;
  Found: Boolean;
  Rect: TRect;
  P: TPoint;
  Index: Integer;
  InsideContainer: TaqInsideContainerFriend;
begin
  Result := drtNone;
  if ManagedItem = nil then
    Exit;

  for Result := drtLeft to drtDetachedBottom do
  begin
    Region := GetDockingZoneRgn(Result);
    Found := PtInRegion(Region, APoint.X, APoint.Y);
    if Region <> aqNullHandle then
      DeleteObject(Region);
    if Found then
      Exit;
  end;
  if PtInRect(ManagedItem.ScreenRect, APoint) then
  begin
    P := ManagedItem.ScreenToClient(APoint);
    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 (Index <> InsideContainer.GetVirtualTabIndex) and
          (P.X - InsideContainer.TabInfo[Index].Size div 2 <= InsideContainer.TabInfo[Index].Origin)
          or ((Index = InsideContainer.FirstVisibleTabIndex) and (InsideContainer.GetVirtualTabIndex >= InsideContainer.FirstVisibleTabIndex)) then
          Result := drtInsideBefore
        else
          Result := drtInside;
      end
      else
        Result := drtInside;
    end
    else if ManagedItem is TaqSplitContainer then
    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
      Result := drtNone;
  end
  else if (ManagedItem.ParentItem = nil) and (ManagedItem.Parent <> nil) and
    PtInRect(TaqCustomDockingSiteFriend(ManagedItem.Parent).GetScreenDockZone, APoint) then
    Result := drtInside
  else
    Result := drtNone;
end;

function TaqVS2005Docker.GetDockingZoneRgn(
  ARegion: TaqDockingRegionType): TaqHandle;
var
  Rect, ScreenRect: TRect;
  P, ZoneOffset: TPoint;
begin
  if HasDockingZone(ARegion) then
  begin
    Rect := TaqCustomDockingControlFriend(ManagedItem).GetInsideRect;
    ScreenRect := ManagedItem.ScreenRect;
    P.X := Rect.Left + (Rect.Right - Rect.Left) div 2;
    P.Y := Rect.Top + (Rect.Bottom - Rect.Top) div 2;
    with Style.FImageMetrics[Style.GetImageIndex(ManagedItem, ARegion)] do
    begin
      Result := aqDuplicateRegion(Region);
      case ARegion of
        drtLeft..drtInside:
          ZoneOffset := Point(Offset.X + P.X, Offset.Y + P.Y);
        drtDetachedLeft:
          begin
            ZoneOffset.X := ScreenRect.Left + Offset.X;
            ZoneOffset.Y := (ScreenRect.Top + ScreenRect.Bottom) div 2 + Offset.Y;
          end;
        drtDetachedRight:
          begin
            ZoneOffset.X := ScreenRect.Right + Offset.X;
            ZoneOffset.Y := (ScreenRect.Bottom + ScreenRect.Top) div 2 + Offset.Y;
          end;
        drtDetachedTop:
          begin
            ZoneOffset.X := (ScreenRect.Left + ScreenRect.Right) div 2 + Offset.X;
            ZoneOffset.Y := ScreenRect.Top + Offset.Y;
          end;
        drtDetachedBottom:
          begin
            ZoneOffset.X := (ScreenRect.Left + ScreenRect.Right) div 2 + Offset.X;
            ZoneOffset.Y := ScreenRect.Bottom + Offset.Y;
          end;
      else
        Assert(False);
      end;
      OffsetRgn(Result, ZoneOffset.X, ZoneOffset.Y);
    end
  end
  else
    Result := aqNullHandle;
end;

function TaqVS2005Docker.GetStyle: TaqVS2005DockingStyle;
begin
  Result := TaqVS2005DockingStyle(inherited Style);
end;

function TaqVS2005Docker.GetDockingZoneOffset(ARegion: TaqDockingRegionType): TPoint;
var
  ScreenRect: TRect;
  P:  TPoint;
begin
  ScreenRect := ManagedItem.ScreenRect;
  P.X := ScreenRect.Left + (ScreenRect.Right - ScreenRect.Left) div 2;
  P.Y := ScreenRect.Top + (ScreenRect.Bottom - ScreenRect.Top) div 2;
  with Style.FImageMetrics[Style.GetImageIndex(ManagedItem, ARegion)] do
    case ARegion of
      drtLeft..drtInside:
        Result := Point(Offset.X + P.X, Offset.Y + P.Y);
      drtDetachedLeft:
        begin
          Result.X := ScreenRect.Left + Offset.X;
          Result.Y := (ScreenRect.Top + ScreenRect.Bottom) div 2 + Offset.Y;
        end;
      drtDetachedRight:
        begin
          Result.X := ScreenRect.Right + Offset.X;
          Result.Y := (ScreenRect.Bottom + ScreenRect.Top) div 2 + Offset.Y;
        end;
      drtDetachedTop:
        begin
          Result.X := (ScreenRect.Left + ScreenRect.Right) div 2 + Offset.X;
          Result.Y := ScreenRect.Top + Offset.Y;
        end;
      drtDetachedBottom:
        begin
          Result.X := (ScreenRect.Left + ScreenRect.Right) div 2 + Offset.X;
          Result.Y := ScreenRect.Bottom + Offset.Y;
        end;
    else
      Assert(False);
    end;

end;

function TaqVS2005Docker.HasDockingZone(
  ARegion: TaqDockingRegionType): Boolean;
begin
  Result := ManagedItem is TaqDockingControl;
  if Result then
  begin
    if ManagedItem.DockingManager.DragDockControl <> ManagedItem then
      Result := ARegion in [drtLeft..drtInside]
    else
      Result := False;
  end
end;

function TaqVS2005MainItemDocker.GetDockingRegionType(
  APoint: TPoint): TaqDockingRegionType;
var
  Region: TaqHandle;
  Found: Boolean;
  P: TPoint;
  InsideContainer: TaqInsideContainerFriend;
  Index: Integer;
begin
  Result := drtNone;
  if ManagedItem = nil then
    Exit;

  for Result := drtDetachedLeft to drtDetachedBottom do
  begin
    if not HasDockingZone(Result) then
      Continue;
    Region := GetDockingZoneRgn(Result);
    Found := PtInRegion(Region, APoint.X, APoint.Y);
    if Region <> aqNullHandle then
      DeleteObject(Region);
    if Found then
      Exit;
  end;
  Result := drtNone;

  if PtInRect(ManagedItem.ScreenRect, APoint) then
  begin
    P := ManagedItem.ScreenToClient(APoint);
    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 (Index <> InsideContainer.GetVirtualTabIndex) and
          (P.X - InsideContainer.TabInfo[Index].Size div 2 <= InsideContainer.TabInfo[Index].Origin)
          or ((Index = InsideContainer.FirstVisibleTabIndex) and (InsideContainer.GetVirtualTabIndex >= InsideContainer.FirstVisibleTabIndex)) then
          Result := drtInsideBefore
        else
          Result := drtInside;
      end
      else
        Result := drtInside;
    end
  end;
end;

function TaqVS2005MainItemDocker.GetDockingZoneRgn(ARegion: TaqDockingRegionType): TaqHandle;
var
  ScreenRect: TRect;
  ZoneOffset: TPoint;
begin
  if HasDockingZone(ARegion) then
  begin
    ScreenRect := ManagedItem.ScreenRect;
    with Style.FImageMetrics[Style.GetImageIndex(ManagedItem, ARegion)] do
    begin
      Result := aqDuplicateRegion(Region);
      case ARegion of
        drtDetachedLeft:
          begin
            ZoneOffset.X := ScreenRect.Left + Offset.X;
            ZoneOffset.Y := (ScreenRect.Top + ScreenRect.Bottom) div 2 + Offset.Y;
          end;
        drtDetachedRight:
          begin
            ZoneOffset.X := ScreenRect.Right + Offset.X;
            ZoneOffset.Y := (ScreenRect.Bottom + ScreenRect.Top) div 2 + Offset.Y;
          end;
        drtDetachedTop:
          begin
            ZoneOffset.X := (ScreenRect.Left + ScreenRect.Right) div 2 + Offset.X;
            ZoneOffset.Y := ScreenRect.Top + Offset.Y;
          end;
        drtDetachedBottom:
          begin
            ZoneOffset.X := (ScreenRect.Left + ScreenRect.Right) div 2 + Offset.X;
            ZoneOffset.Y := ScreenRect.Bottom + Offset.Y;
          end;
      else
        Assert(False);
      end;
      OffsetRgn(Result, ZoneOffset.X, ZoneOffset.Y);
    end
  end
  else
    Result := aqNullHandle;
end;

function TaqVS2005MainItemDocker.HasDockingZone(ARegion: TaqDockingRegionType): Boolean;
begin
  Result := ((ManagedItem.ParentItem = nil) and
    (ManagedItem.Parent = TaqDockingManager(DockingManager).MainDockSite)) or
    ((ManagedItem is TaqInsideContainer) and GetBooleanValue(TaqInsideContainer(ManagedItem).ShowInsideContainerDockZones,
        TaqDockingManager(DockingManager).ShowInsideContainerDockZones));
  if Result then
    Result := ARegion in [drtDetachedLeft..drtDetachedBottom];
end;

procedure TaqVS2005DockingFrameOptions.RegisterForm(
  AForm: TaqVS2005MaskForm);
begin
  AForm.Transparency := Transparency;
  AForm.Brush := Brush;
  AForm.Border := Border;
  AForm.FrameSize := BorderSize;
  AForm.OnCustomPaint := DoCustomFramePaint;
  FForm := AForm;
end;

procedure TaqVS2005DockingFrameOptions.SetBorder(const Value: TBrush);
begin
  FBorder.Assign(Value);
end;

procedure TaqVS2005DockingFrameOptions.SetBorderSize(
  const Value: TaqFrameSize);
begin
  if FBorderSize <> Value then
  begin
    FBorderSize := Value;
    if FForm <> nil then
      FForm.FrameSize := FBorderSize;
  end;
end;

procedure TaqVS2005DockingFrameOptions.SetBrush(const Value: TBrush);
begin
  FBrush.Assign(Value);
end;

procedure TaqVS2005DockingFrameOptions.UnregisterForm;
begin
  FForm := nil;
end;

initialization
  aqDockingStyles.RegisterClass(SVS2005DockingStyleName, TaqVS2005DockingStyle);

finalization
  aqDockingStyles.UnregisterClass(SVS2005DockingStyleName);
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -