aqdockingvs2005.pas

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

begin
  if Source is TaqVS2005DockingStyle then
  begin
    inherited;
    with TaqVS2005DockingStyle(Source) do
    begin
      Self.ActiveDockZone := ActiveDockZone;
      Self.DockingFrame := DockingFrame;
      Self.DockZone := DockZone;
    end
  end
  else
    inherited;
end;

constructor TaqVS2005DockingStyle.Create(AOwner: TComponent);
begin
  inherited;
  FAppEvents := TApplicationEvents.Create(nil);
  FAppEvents.OnSettingChange := AppSettingChange;
  FImages := CreateImageList as TImageListDIB;
  FActiveImages := CreateImageList as TImageListDIB;
  UpdateImages;
  UpdateActiveImages;
  FImageMetrics := GetDockImageMetrics;
  FDockingFrame := TaqVS2005DockingFrameOptions.Create(Self);
  FActiveDockZone := TaqVS2005DockingZoneOptions.Create(Self);
  FActiveDockZone.Transparency := 128;
  FActiveDockZone.ActiveTransparency := 255;
  FActiveDockZone.FadeInDelay := 200;
  FActiveDockZone.FadeOutDelay := 250;
  FDockZone := TaqVS2005DockingZoneOptions.Create(Self);
  FDockZone.Transparency := 0;
  FDockZone.ActiveTransparency := 128;
  FDockZone.FadeInDelay := 50;
  FDockZone.FadeOutDelay := 1000;
  TabOrientation := aqDockingVS2005.DefaultTabOrientation;
  FFlashZonesOnStart := True;
end;

destructor TaqVS2005DockingStyle.Destroy;
var
  I: TaqDockingZoneImage;
begin
  FreeAndNil(FAppEvents);
  FreeAndNil(FDockingFrame);
  FreeAndNil(FActiveDockZone);
  FreeAndNil(FDockZone);
  FreeAndNil(FActiveImages);
  FreeAndNil(FImages);
  for I := Low(TaqDockingZoneImage) to High(TaqDockingZoneImage) do
    if FImageMetrics[I].Region <> aqNullHandle then
      DeleteObject(FImageMetrics[I].Region);
  inherited;
end;

function TaqVS2005DockingStyle.GetDockerClass(
  DockClass: TaqCustomDockingControlClass): TaqDockerClass;
begin
  if DockClass.InheritsFrom(TaqWorkspaceControl) then
    Result := TaqWorkspaceDocker
  else if DockClass.InheritsFrom(TaqCustomDockingContainer) then
    Result := TaqVS2005MainItemDocker
  else if DockClass.InheritsFrom(TaqCustomDockingControl) then
    Result := TaqVS2005Docker
  else
    Result := nil;
end;

function TaqVS2005DockingStyle.GetDockingFrameClass: TaqDockingFrameClass;
begin
  Result := TaqVS2005DockingFrame;
end;

function TaqVS2005DockingStyle.GetImages: TImageList;
begin
  Result := FImages as TImageList;
end;

function TaqVS2005DockingStyle.GetActiveImages: TImageList;
begin
  Result := FActiveImages as TImageList;
end;

function TaqVS2005DockingStyle.GetMoverClass: TaqMoverClass;
begin
  Result := TaqVS2005Mover;
end;

procedure TaqVS2005DockingStyle.SetActiveDockZone(
  const Value: TaqVS2005DockingZoneOptions);
begin
  if Value <> nil then
    FActiveDockZone.Assign(Value);
end;

function TaqVS2005DockingStyle.GetDockImageMetrics: TaqDockingZoneImageMetrics;
var
  I: TaqDockingZoneImage;
  R: TRect;
begin
  for I := Low(TaqDockingZoneImage) to High(TaqDockingZoneImage) do
    with Result[i] do
    begin
      Region := 0;
      FImages.CreateRegionFromItem(i, Region);
      GetRgnBox(Region, R);
      Size.X := R.Right - R.Left;
      Size.Y := R.Bottom - R.Top;
    end;
  // Preparing offsets
  with Result[dziInside] do
  begin
    Offset := Point(-Size.X div 2, -Size.Y div 2);
    Result[dziInsideBottom].Offset := Offset;
  end;
  with Result[dziLeft] do
    Offset := Point(-Size.X + 7 + Result[dziInside].Offset.X, -Size.Y div 2);
  with Result[dziRight] do
    Offset := Point(- 5 - Result[dziInside].Offset.X, -Size.Y div 2);
  with Result[dziTop] do
    Offset := Point(-Size.X div 2, -Size.Y + 7 + Result[dziInside].Offset.Y);
  with Result[dziBottom] do
    Offset := Point(-Size.X div 2, - 5 - Result[dziInside].Offset.Y);
  with Result[dziDetachedLeft] do
    Offset := Point(0, -Size.Y div 2);
  with Result[dziDetachedTop] do
    Offset := Point(-Size.X div 2, 0);
  with Result[dziDetachedRight] do
    Offset := Point(-Size.X, -Size.Y div 2);
  with Result[dziDetachedBottom] do
    Offset := Point(-Size.X div 2, -Size.Y);
end;

procedure TaqVS2005DockingStyle.SetDockingFrame(
  const Value: TaqVS2005DockingFrameOptions);
begin
  if Value <> nil then
    FDockingFrame.Assign(Value);
end;

procedure TaqVS2005DockingStyle.SetDockZone(
  const Value: TaqVS2005DockingZoneOptions);
begin
  if FDockZone <> Value then
    FDockZone.Assign(Value);
end;

function TaqVS2005DockingStyle.CreateImageList: TImageList;
begin
  Result := TImageListDIB.CreateSize(41, 41);
end;

function TaqVS2005DockingStyle.HasActiveImages: Boolean;
begin
  Result := True;
end;

procedure TaqVS2005DockingStyle.UpdateImages;
var
  I: TaqDockingZoneImage;
begin
  FImages.Clear;
  for I := Low(TaqDockingZoneImage) to High(TaqDockingZoneImage) do
    FImages.GetInstRes(HInstance, rtBitmap, SDockImageResNames[I], 0,
      LR_CREATEDIBSECTION{lrMap3DColors}, clFuchsia);
end;

procedure TaqVS2005DockingStyle.UpdateActiveImages;
var
  I: TaqDockingZoneImage;
begin
  FActiveImages.Clear;
  for I := Low(TaqDockingZoneImage) to High(TaqDockingZoneImage) do
    FActiveImages.GetInstRes(HInstance, rtBitmap, SActiveImagePrefix + SDockImageResNames[I], 0,
      LR_CREATEDIBSECTION{lrMap3DColors}, clFuchsia);
end;

function TaqVS2005DockingStyle.GetImageIndex(Control: TaqCustomDockingControl;
  Region: TaqDockingZoneRegion): TaqDockingZoneImage;
begin
  if (Region = drtInside) and (Control <> nil) and (((Control.ParentItem is TaqInsideContainer) and
    (TaqInsideContainer(Control.ParentItem).Orientation = dtoBottom))
      or ((TabOrientation = dtoBottom) and not (Control.ParentItem is TaqInsideContainer))) then
    Result := dziInsideBottom
  else
    Result := Ord(Region);
end;

{ TaqTranslucentForm }

procedure TaqTranslucentForm.CNKeyDown(var Message: TWMKeyDown);
begin
  // do nothing
end;

procedure TaqTranslucentForm.CNSysKeyDown(var Message: TWMKeyDown);
begin
  // do nothing
end;

constructor TaqTranslucentForm.CreateNew(AOwner: TComponent;
  Dummy: Integer);
begin
  inherited;
  ControlStyle := [];
  BorderStyle := bsNone;
  FormStyle := fsStayOnTop;
  Scaled := False;
end;

procedure TaqTranslucentForm.WMCaptureChanged(var Message: TMessage);
begin
  EndDrag(True);
end;

procedure TaqTranslucentForm.WMEraseBackground(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

{ TaqVS2005MaskForm }

constructor TaqVS2005MaskForm.Create;
begin
  inherited;
  FBrush := TBrush.Create;
  FBrush.OnChange := DoColorChanged;
  FBorder := TBrush.Create;
  FBorder.OnChange := DoColorChanged;
end;

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

procedure TaqVS2005MaskForm.DoColorChanged(Sender: TObject);
begin
  if Form <> nil then
    Form.Invalidate;
end;

procedure TaqVS2005MaskForm.DoCreateMask;
begin
  inherited;
  UpdateTransparency;
end;

procedure TaqVS2005MaskForm.FormPaint(Sender: TObject);
var
  DC, Rgn: THandle;
  DefaultDrawing: Boolean;
  Rect: TRect;
begin
  if Destroyed or DragFinished then
    Exit;
  Rgn := Region;
  Rect := Form.ClientRect;
  DefaultDrawing := True;
  if Assigned(FOnCustomPaint) then
    FOnCustomPaint(Self, Form.Canvas, Rgn, Rect, cpsBefore, DefaultDrawing);
  if DefaultDrawing then
  begin
    DC := Form.Canvas.Handle;
    FillRgn(DC, Rgn, FBrush.Handle);
    if Transparency < 255 then
      FrameRgn(DC, Rgn, FBorder.Handle, FrameSize, FrameSize);
  end;
  if Assigned(FOnCustomPaint) then
    FOnCustomPaint(Self, Form.Canvas, Rgn, Rect, cpsAfter, DefaultDrawing);
end;

function TaqVS2005MaskForm.GetFormClass: TCustomFormClass;
begin
  Result := TaqTranslucentForm;
end;

procedure TaqVS2005MaskForm.SetBoundsRect(const Value: TRect);
var
  SizeChanged: Boolean;
begin
  // NOTE: This is a workaround of translucent window flicking if
  // the window is resized and moved simultaneously.
  SizeChanged := Visible and ((Value.Right - Value.Left <> Form.Width) or
    (Value.Bottom - Value.Top <> Form.Height));
  if SizeChanged and (Transparency < 255) then
  begin
    aqLockWindowRedraw(Form.Handle);
    TaqTranslucentForm(Form).AlphaBlend := False;
  end;
  inherited;
  if SizeChanged and (Transparency < 255) then
  begin
    TaqTranslucentForm(Form).AlphaBlend := True;
    aqUnlockWindowRedraw(Form.Handle);
  end;
end;

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

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

procedure TaqVS2005MaskForm.SetTransparency(const Value: Byte);
begin
  if FTransparency <> Value then
  begin
    FTransparency := Value;
    if not TransparencyAvailable then
      FTransparency := 255;
    UpdateTransparency;
  end;
end;

procedure TaqVS2005MaskForm.UpdateTransparency;
begin
  if Form <> nil then
  begin
    Form.ControlStyle := Form.ControlStyle - [csOpaque, csDoubleClicks];
    with TaqTranslucentForm(Form) do
      if FTransparency < 255 then
      begin
        AlphaBlend := True;
        AlphaBlendValue := FTransparency;
      end
      else
        AlphaBlend := False;
  end;
end;

{ TaqVS2005DockingFrame }

constructor TaqVS2005DockingFrame.Create(
  ADockingManager: TaqCustomDockingManager);
begin
  inherited;
  Style.DockingFrame.RegisterForm(TaqVS2005MaskForm(MaskForm));
end;

destructor TaqVS2005DockingFrame.Destroy;
begin
  Style.DockingFrame.UnregisterForm;
  inherited;
end;

function TaqVS2005DockingFrame.GetMaskFormClass: TaqCustomMaskFormClass;
begin
  Result := TaqVS2005MaskForm;
end;

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

{ TaqVS2005Mover }

procedure TaqVS2005Mover.CancelDragging(const Coord: TPoint);
begin
  FDragDockControlSite := nil;
  FDragJustStarted := False;
  ClearDockingZones;
  inherited;
end;

procedure TaqVS2005Mover.ClearDockingZones;
begin
  if FControllers <> nil then
  begin
    with ControllerIterator do
      try
        while HasNext do
          TaqDockingZoneController(Next.Data).Free;
      finally
        Free;
      end;
    FControllers.Clear;
  end;
  FActiveControllers.Clear;
  FHotController := nil;
end;