У меня есть a 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;
Если или Сдвиг или клавиша Ctrl будут удерживаться, то операция прикрепления будет запущена, иначе вкладки могут быть перестроены путем перетаскивания их.
Используя ключи как модификаторы является неловким все же. Там какой-либо путь состоит в том, чтобы отменить активную операцию перетаскивания, когда курсор мыши за пределами области вкладки управления страницей, и начните прикреплять дочернюю форму? Это - с Delphi 2009.
Сейчас у меня есть решение, которое работает для меня, поэтому я отвечу сам себе - может быть, кому-то это тоже пригодится.
Давайте начнем с небольшого примера приложения, которое создает TPageControl
с 8 пристыкованными формами, с кодом, позволяющим во время выполнения менять порядок вкладок. Вкладки будут перемещаться в реальном времени, а при отмене перетаскивания индекс активной вкладки вернется к исходному значению:
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.