Delphi拖动可以“升级”到对接吗？

Question

我有一个TPageControl，其页面都是使用ManualDock()附加的各种表单。用户应该能够通过拖动来重新排列选项卡，这已经有效。但也应该可以取消对接表格。

现在我有以下代码：

procedure TMainForm.PageControlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (Shift * [ssShift, ssCtrl] = [])
    and PageControl.DockSite
  then begin
    PageControl.BeginDrag(False, 32);
  end;
end;

如果按住 Shift 或 Ctrl 键，则会启动停靠操作，否则可以通过拖动来重新排列选项卡。

虽然使用键作为修饰符很尴尬。当鼠标光标位于页面控件的选项卡区域之外时，有没有办法取消活动拖动操作，并开始对接子窗体？这是Delphi 2009。

Answer 1

我现在有一个适合我的解决方案，所以我会自己回答 - 也许有人也可以使用它。

让我们从一个小示例应用程序开始，该应用程序创建一个带有8个停靠表单的TPageControl，其代码允许运行时重新排序选项卡。标签将被实时移动，当取消拖动时，活动标签索引将恢复为其原始值：

unit uDragDockTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ComCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    fPageControl: TPageControl;
    fPageControlOriginalPageIndex: integer;
    function GetPageControlTabIndex(APosition: TPoint): integer;
  public
    procedure PageControlDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure PageControlDragOver(Sender, Source: TObject; X, Y: Integer;
      AState: TDragState; var AAccept: Boolean);
    procedure PageControlEndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure PageControlMouseDown(Sender: TObject; AButton: TMouseButton;
      AShift: TShiftState; X, Y: Integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  FormColors: array[1..8] of TColor = (
    clRed, clGreen, clBlue, clYellow, clLime, clMaroon, clTeal, clAqua);
var
  i: integer;
  F: TForm;
begin
  fPageControlOriginalPageIndex := -1;

  fPageControl := TPageControl.Create(Self);
  fPageControl.Align := alClient;
  // set to False to enable tab reordering but disable form docking
  fPageControl.DockSite := True;
  fPageControl.Parent := Self;

  fPageControl.OnDragDrop := PageControlDragDrop;
  fPageControl.OnDragOver := PageControlDragOver;
  fPageControl.OnEndDrag := PageControlEndDrag;
  fPageControl.OnMouseDown := PageControlMouseDown;

  for i := Low(FormColors) to High(FormColors) do begin
    F := TForm.Create(Self);
    F.Caption := Format('Form %d', [i]);
    F.Color := FormColors[i];
    F.DragKind := dkDock;
    F.BorderStyle := bsSizeToolWin;
    F.FormStyle := fsStayOnTop;
    F.ManualDock(fPageControl);
    F.Show;
  end;
end;

const
  TCM_GETITEMRECT = $130A;

function TForm1.GetPageControlTabIndex(APosition: TPoint): integer;
var
  i: Integer;
  TabRect: TRect;
begin
  for i := 0 to fPageControl.PageCount - 1 do begin
    fPageControl.Perform(TCM_GETITEMRECT, i, LPARAM(@TabRect));
    if PtInRect(TabRect, APosition) then
      Exit(i);
  end;
  Result := -1;
end;

procedure TForm1.PageControlDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  Index: integer;
begin
  if Sender = fPageControl then begin
    Index := GetPageControlTabIndex(Point(X, Y));
    if (Index <> -1) and (Index <> fPageControl.ActivePage.PageIndex) then
      fPageControl.ActivePage.PageIndex := Index;
  end;
end;

procedure TForm1.PageControlDragOver(Sender, Source: TObject; X, Y: Integer;
  AState: TDragState; var AAccept: Boolean);
var
  Index: integer;
begin
  AAccept := Sender = fPageControl;
  if AAccept then begin
    Index := GetPageControlTabIndex(Point(X, Y));
    if (Index <> -1) and (Index <> fPageControl.ActivePage.PageIndex) then
      fPageControl.ActivePage.PageIndex := Index;
  end;
end;

procedure TForm1.PageControlEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  // restore original index of active page if dragging was canceled
  if (Target <> fPageControl) and (fPageControlOriginalPageIndex > -1)
    and (fPageControlOriginalPageIndex < fPageControl.PageCount)
  then
    fPageControl.ActivePage.PageIndex := fPageControlOriginalPageIndex;
  fPageControlOriginalPageIndex := -1;
end;

procedure TForm1.PageControlMouseDown(Sender: TObject; AButton: TMouseButton;
  AShift: TShiftState; X, Y: Integer);
begin
  if (AButton = mbLeft)
    // undock single docked form or reorder multiple tabs
    and (fPageControl.DockSite or (fPageControl.PageCount > 1))
  then begin
    // save current active page index for restoring when dragging is canceled
    fPageControlOriginalPageIndex := fPageControl.ActivePageIndex;
    fPageControl.BeginDrag(False);
  end;
end;

end.

将其粘贴到编辑器中并运行它，将在运行时创建并设置所有必需的组件及其属性。

请注意，只有双击选项卡才能取消停靠表单。无论与标签的距离如何，只有在释放鼠标左键时才会显示拖动光标，这也有点难看。当鼠标位于页面控制选项卡区域之外并且带有几个像素边距时，如果拖动被自动取消并且表单被取消停靠会好得多。

这可以通过在页面控件的DragObject处理程序中创建自定义OnStartDrag来实现。在此对象中捕获鼠标，因此可以在其中处理拖动时的所有鼠标消息。当鼠标光标位于选项卡影响矩形之外时，将取消拖动，而是启动活动页面控制表中表单的停靠操作：

type
  TConvertDragToDockHelper = class(TDragControlObjectEx)
  strict private
    fPageControl: TPageControl;
    fPageControlTabArea: TRect;
  protected
    procedure WndProc(var AMsg: TMessage); override;
  public
    constructor Create(AControl: TControl); override;
  end;

constructor TConvertDragToDockHelper.Create(AControl: TControl);
const
  MarginX = 32;
  MarginY = 12;
var
  Item0Rect, ItemLastRect: TRect;
begin
  inherited;
  fPageControl := AControl as TPageControl;
  if fPageControl.PageCount > 0 then begin
    // get rects of first and last tab
    fPageControl.Perform(TCM_GETITEMRECT, 0, LPARAM(@Item0Rect));
    fPageControl.Perform(TCM_GETITEMRECT, fPageControl.PageCount - 1,
      LPARAM(@ItemLastRect));
    // calculate rect valid for dragging (includes some margin around tabs)
    // when this area is left dragging will be canceled and docking will start
    fPageControlTabArea := Rect(
      Min(Item0Rect.Left, ItemLastRect.Left) - MarginX,
      Min(Item0Rect.Top, ItemLastRect.Top) - MarginY,
      Max(Item0Rect.Right, ItemLastRect.Right) + MarginX,
      Max(Item0Rect.Bottom, ItemLastRect.Bottom) + MarginY);
  end;
end;

procedure TConvertDragToDockHelper.WndProc(var AMsg: TMessage);
var
  MousePos: TPoint;
  CanUndock: boolean;
begin
  inherited;
  if AMsg.Msg = WM_MOUSEMOVE then begin
    MousePos := fPageControl.ScreenToClient(Mouse.CursorPos);
    // cancel dragging if outside of tab area with margins
    // optionally start undocking the docked form (can be canceled with [ESC])
    if not PtInRect(fPageControlTabArea, MousePos) then begin
      fPageControl.EndDrag(False);
      CanUndock := fPageControl.DockSite and (fPageControl.ActivePage <> nil)
        and (fPageControl.ActivePage.ControlCount > 0)
        and (fPageControl.ActivePage.Controls[0] is TForm)
        and (TForm(fPageControl.ActivePage.Controls[0]).DragKind = dkDock);
      if CanUndock then
        fPageControl.ActivePage.Controls[0].BeginDrag(False);
    end;
  end;
end;

该类从TDragControlObjectEx而非TDragControlObject下降，以便自动释放。现在，如果创建了示例应用程序中TPageControl的处理程序（并为页面控制对象设置）：

procedure TForm1.PageControlStartDrag(Sender: TObject;
  var ADragObject: TDragObject);
begin
  // do not cancel dragging unless page control has docking enabled
  if (ADragObject = nil) and fPageControl.DockSite then
    ADragObject := TConvertDragToDockHelper.Create(fPageControl);
end;

然后当鼠标远离标签移动时，标签拖动将被取消，如果活动页面是可停靠的表格，则将启动它的停靠操作，仍然可以使用取消ESC 键。