aqdockingvs2005.pas

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

  if FRegion <> aqNullHandle then
    DeleteObject(FRegion);
  if not (GetRgnBox(ARegion, Rect) in [aqRegionError, aqRegionEmpty]) then
    BoundsRect := Rect;
  FRegion := aqDuplicateRegion(ARegion);
end;

{ TaqDockingZoneController }

constructor TaqDockingZoneController.Create(AStyle: TaqVS2005DockingStyle;
  AControl: TaqCustomDockingControl);
var
  R: TaqDockingZoneRegion;
  Region: TaqHandle;
begin
  inherited Create;
  FStyle := AStyle;
  FControl := AControl;
  FDocker := TaqDocker(FControl.DockingManager.Docker[FControl.DockClass]);
  FDocker := TaqDocker(TaqCustomDockerClass(FDocker.ClassType).Create(FControl.DockingManager));
  FDocker.ManagedItem := FControl;
  for R := Low(R) to High(R) do
    if FDocker.HasDockingZone(R) then
    begin
      FDockZones[R] := TaqDockingZone.CreateEx(FStyle.FImages, FStyle.FActiveImages, FStyle.GetImageIndex(FControl, R));
      Region := FDocker.GetDockingZoneRgn(R);
      FDockZones[R].SetRegion(Region);
      DeleteObject(Region);
    end
    else
      FDockZones[R] := nil;
  FActiveRegion := drtNone;
end;

destructor TaqDockingZoneController.Destroy;
var
  R: TaqDockingZoneRegion;
begin
  for R := Low(R) to High(R) do
    if FDockZones[R] <> nil then
    begin
      if FDockZones[R].HandleAllocated then
        FDockZones[R].Release;
      FDockZones[R] := nil;
    end;
  FreeAndNil(FDocker);
  inherited;
end;

procedure TaqDockingZoneController.Fade(Transparency: Byte; FadeDelay: TaqDockerFadeDelay);
var
  R: TaqDockingZoneRegion;
begin
  for R := Low(R) to High(R) do
    if FDockZones[R] <> nil then
      FDockZones[R].Fade(Transparency, FadeDelay);
end;

function TaqDockingZoneController.FindDockingRegion(
  APoint: TPoint): TaqDockingRegionType;
var
  Region: TaqHandle;
  Found: Boolean;
begin
  for Result := drtLeft to drtDetachedBottom do
  begin
    Region := FDocker.GetDockingZoneRgn(Result);
    Found := PtInRegion(Region, APoint.X, APoint.Y);
    if Region <> aqNullHandle then
      DeleteObject(Region);
    if Found then
      Exit;
  end;
  Result := drtNone;
  //Result := FDocker.GetDockingRegionType(APoint);
end;

function TaqDockingZoneController.GetDockZones(
  Region: TaqDockingZoneRegion): TaqDockingZone;
begin
  Result := FDockZones[Region];
end;

procedure TaqDockingZoneController.Hide;
var
  R: TaqDockingZoneRegion;
begin
  for R := Low(R) to High(R) do
    if FDockZones[R] <> nil then
      FDockZones[R].Hide;
end;

procedure TaqDockingZoneController.SetActiveRegion(ARegionType: TaqDockingRegionType);
begin
  if ARegionType <> FActiveRegion then
  begin
    if (FActiveRegion in [Low(TaqDockingZoneRegion)..High(TaqDockingZoneRegion)]) and
      (FDockZones[FActiveRegion] <> nil) then
      begin
        FDockZones[FActiveRegion].FActive := False;
        with FStyle.ActiveDockZone do
          FDockZones[FActiveRegion].Fade(Transparency, FadeOutDelay);
      end;
    FActiveRegion := ARegionType;
    if (FActiveRegion in [Low(TaqDockingZoneRegion)..High(TaqDockingZoneRegion)]) and
      (FDockZones[FActiveRegion] <> nil) then
      begin
        FDockZones[FActiveRegion].FActive := True;
        with FStyle.ActiveDockZone do
          FDockZones[FActiveRegion].Fade(ActiveTransparency, FadeInDelay);
      end;
  end;
end;

procedure TaqDockingZoneController.Show(Transparency: Byte);
var
  R: TaqDockingZoneRegion;
begin
  for R := Low(R) to High(R) do
    if FDockZones[R] <> nil then
      FDockZones[R].MakeVisible(Transparency);
end;

{ TaqFrameOptions }

procedure TaqVS2005DockingFrameOptions.Assign(Source: TPersistent);
begin
  if Source is TaqVS2005DockingFrameOptions then
    with TaqVS2005DockingFrameOptions(Source) do
    begin
      Self.Border := Border;
      Self.BorderSize := BorderSize;
      Self.Brush := Brush;
      Self.Transparency := Transparency;
    end
  else
    inherited;
end;

constructor TaqVS2005DockingFrameOptions.Create(AOwner: TaqVS2005DockingStyle);
begin
  inherited Create;
  FOwner := AOwner;
  FTransparency := 128;
  FBrush := TBrush.Create;
  FBrush.Color := clHighlight;
  FBrush.OnChange := DoColorChanged;
  FBorder := TBrush.Create;
  FBorder.Color := clWhite;
  FBorder.OnChange := DoColorChanged;
  FBorderSize := 2;
end;

destructor TaqVS2005DockingFrameOptions.Destroy;
begin
  FreeAndNil(FBrush);
  FreeAndNil(FBorder);
  inherited;
end;

procedure TaqVS2005DockingFrameOptions.DoColorChanged(Sender: TObject);
begin
  if FForm <> nil then
  begin
    FForm.Brush := Brush;
    FForm.Border := Border;
  end;
end;

procedure TaqVS2005DockingFrameOptions.DoCustomFramePaint(Sender: TObject;
  Canvas: TCanvas; Region: TaqHandle; Rect: TRect;
  Stage: TaqCustomPaintStage; var DefaultDrawing: Boolean);
begin
  if Assigned(FOnCustomPaint) then
    FOnCustomPaint(Sender, Canvas, Region, Rect, Stage, DefaultDrawing);
end;

function TaqVS2005DockingFrameOptions.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TaqVS2005Mover.SetHotControllerActiveRegion(Point: TPoint);
var
  i: Integer;
  DockRegion: TaqDockingRegionType;
begin
  for i := 0 to FActiveControllers.Count - 1 do
  begin
    DockRegion := TaqDockingZoneController(FActiveControllers[i]).FindDockingRegion(Point);
    if DockRegion <> drtNone then
    begin
      FHotController := FActiveControllers[i];
      FHotController.ActiveRegion := DockRegion;
      break;
    end;
  end;
end;

procedure TaqVS2005Mover.SetActiveControllers(Value: TList);
var
  i: Integer;
  CurrentController: TaqDockingZoneController;
begin
  for i := 0 to FActiveControllers.Count - 1 do
  begin
    CurrentController := FActiveControllers[i];
    if Value.IndexOf(CurrentController) = -1 then
      CurrentController.Fade(Style.DockZone.Transparency, Style.DockZone.FadeOutDelay);
  end;

  for i := 0 to Value.Count - 1 do
  begin
    CurrentController := Value[i];
    if FActiveControllers.IndexOf(CurrentController) = -1 then
      CurrentController.Fade(Style.ActiveDockZone.Transparency, Style.ActiveDockZone.FFadeInDelay);
  end;

  FActiveControllers.Free;
  FActiveControllers := Value;
end;

procedure TaqVS2005Mover.UpdateActiveControllers(Control: TaqCustomDockingControl;
  Point: TPoint; CanDock: Boolean);
var
  Controller: TaqDockingZoneController;
  NewActiveControllers: TList;
begin
  Controller := ControllerByControl(Control);

  if FHotController <> nil then
    FHotController.SetActiveRegion(drtNone);

  NewActiveControllers := ControllersByControl(Control);
  SetActiveControllers(NewActiveControllers);
  FHotController := Controller;

  if CanDock then
    SetHotControllerActiveRegion(Point)
  else
    if FHotController <> nil then
      FHotController.ActiveRegion := drtNone;
end;

function TaqVS2005Mover.ControllerIterator: TaqCustomBucketListIterator;
begin
  Result := FControllers.Iterator;
end;

function TaqVS2005Mover.ControllerByControl(
  AControl: TaqCustomDockingControl): TaqDockingZoneController;
var
  Data: Pointer;
begin
  if FControllers.Find(AControl, Data) then
    Result := Data
  else
    Result := nil;
end;

function TaqVS2005Mover.ControllersByControl(AControl: TaqCustomDockingControl): TList;
var
  Controller: TaqDockingZoneController;
begin
  Result := TList.Create;
  while AControl <> nil do
  begin
    Controller := ControllerByControl(AControl);
    if Controller <> nil then
      Result.Add(Controller);
    AControl := AControl.ParentItem;
  end;
end;

procedure TaqVS2005Mover.DoDragDock(Target: TaqCustomDockingControl;
  Coord: TPoint; FrameRgn: TaqHandle; var Info: string; var CanDock,
  CanFloat: Boolean);
begin
  inherited;

  if FShowAllDockZones then
  begin
    if aqMouseTrack(Coord, FOriginDragPosition) >= DockingManager[uidmMouseTrackBeforeDocking] then
    begin
      FShowAllDockZones := False;
      with ControllerIterator do
        try
          while HasNext do
            with Style do
              TaqDockingZoneController(Next.Data).Fade(DockZone.Transparency, DockZone.FadeOutDelay);
        finally
          Free;
        end;
    end
  end
  else
  begin
    Target := FindDockingControlInternal(Coord);
    if Target <> nil then
      UpdateActiveControllers(Target, Coord, CanDock)
    else
      UpdateActiveControllers(nil, Point(0, 0), CanDock);
  end;
end;

{ TaqDockingZoneOptions }

procedure TaqVS2005DockingZoneOptions.Assign(Source: TPersistent);
begin
  if Source is TaqVS2005DockingZoneOptions then
  begin
    inherited;
    with TaqVS2005DockingZoneOptions(Source) do
    begin
      Self.ActiveTransparency := ActiveTransparency;
      Self.FadeInDelay := FadeInDelay;
      Self.FadeOutDelay := FadeOutDelay;
      Self.Transparency := Transparency;
    end;
  end
  else
    inherited;
end;

constructor TaqVS2005DockingZoneOptions.Create(AOwner: TaqVS2005DockingStyle);
begin
  inherited Create;
  FOwner := AOwner;
end;

procedure TaqVS2005DockingZoneOptions.DoColorChanged(Sender: TObject);
begin

end;

function TaqVS2005DockingZoneOptions.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

{ TaqVS2005Docker }

function TaqVS2005Docker.GetDockingFrameRgn(ARegion: TaqDockingRegionType;
  ADragControl: TaqCustomDockingControl): THandle;
const
  RegionDataSize = SizeOf(TRgnData) + 2 * SizeOf(TRect);
type
  TRectArray = array [0..MaxByte] of TRect;
  PRectArray = ^TRectArray;
var
  Polygon: PRgnData;
  Rect: TRect;
  Orientation: TaqTabOrientation;
  TabHeight: Integer;
begin
  Rect := GetDockingRect(ARegion, ADragControl);
  if IsRectEmpty(Rect) then
    Result := aqNullHandle
  else if (ManagedItem <> nil) and (ARegion in [drtInside, drtInsideBefore]) and
    not (ManagedItem is TaqInsideContainer) and not (ManagedItem.ParentItem is TaqInsideContainer) then
  begin
    Orientation := Style.TabOrientation;
    TabHeight := DockingManager.Style.GetTabPaneHeight(Orientation,
      ctTab in TaqDockingManager(DockingManager).ShowImages, DockingManager.Images);
    if Orientation = dtoTop then
      Inc(Rect.Top, TabHeight)
    else
      Dec(Rect.Bottom, TabHeight);
    GetMem(Polygon, RegionDataSize);
    FillChar(Polygon^, RegionDataSize, 0);
    Polygon.rdh.dwSize := SizeOf(TRgnDataHeader);
    Polygon.rdh.iType := RDH_RECTANGLES;
    Polygon.rdh.nCount := 2;
    Polygon.rdh.nRgnSize := 2 * SizeOf(TRect);
    Polygon.rdh.rcBound := Rect;
    PRectArray(@Polygon.Buffer[0])[0] := Rect;
    PRectArray(@Polygon.Buffer[0])[1] := Rect;
    if Orientation = dtoTop then
    begin
      PRectArray(@Polygon.Buffer[0])[1].Top := Rect.Top - TabHeight;
      PRectArray(@Polygon.Buffer[0])[1].Bottom := Rect.Top;
    end
    else
    begin
      PRectArray(@Polygon.Buffer[0])[1].Top := Rect.Bottom;
      PRectArray(@Polygon.Buffer[0])[1].Bottom := Rect.Bottom + TabHeight;
    end;
    with PRectArray(@Polygon.Buffer[0])[1] do
    begin
      Left := Min(Left + DockingManager.Style.TabIndent, Right);