मेरे पास अब एक समाधान है जो मेरे लिए काम करता है, इसलिए मैं खुद का जवाब दूंगा - शायद किसी के पास इसका भी उपयोग है।
चलिए एक छोटा सा नमूना अनुप्रयोग शुरू करते हैं जो 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.
संपादक में चिपकाएं और इसे चलाने, सभी आवश्यक घटक और उनके गुणों बनाया है और स्थापित किया जाएगा रनटाइम पर।
ध्यान दें कि फ़ॉर्म को अनदेखा करना केवल टैब पर डबल-क्लिक करके संभव है। यह कुछ हद तक बदसूरत है कि टैब से दूरी के बावजूद, बाएं माउस बटन जारी होने तक ड्रैग कर्सर दिखाया जाएगा। ड्रैगिंग स्वचालित रूप से रद्द हो जाने पर यह बेहतर होगा और इसके बजाय फॉर्म को अनदेखा किया जाएगा, जब माउस पृष्ठ नियंत्रण टैब क्षेत्र के बाहर कुछ पिक्सल मार्जिन के साथ होता है।
यह पृष्ठ नियंत्रण से OnStartDrag हैंडलर में एक कस्टम DragObject बनाने के द्वारा प्राप्त किया जा सकता। इस ऑब्जेक्ट में माउस कैप्चर किया जाता है, इसलिए ड्रैग करते समय सभी माउस संदेश इसे नियंत्रित किए जा सकते हैं। जब माउस कर्सर टैब प्रभाव के बाहर आयत है खींचने रोक दी गई है, और सक्रिय पेज नियंत्रण शीट में फार्म के लिए एक डॉकिंग आपरेशन के बजाय शुरू कर दिया गया है:
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;
तो टैब को खींचते रद्द करते समय टैब से माउस चालें, दूर बहुत दूर है और अगर हो जाएगा सक्रिय पृष्ठ एक डॉक्यूबल फॉर्म है, इसके लिए एक डॉकिंग ऑपरेशन शुरू किया जाएगा, जिसे अभी भी ईएससी कुंजी के साथ रद्द किया जा सकता है।
मुझे नहीं पता, लेकिन मुझे संदेह है कि यदि आपने पृष्ठ नियंत्रण से बाहर निकलने के दौरान begindrag करने का प्रयास किया है, तो आप एक डिस्प्ले ड्रैग/माउस रिलेशनशिप के साथ समाप्त हो जाएंगे। यानी माउस उस चीज से एक इंच दूर है जिसे आप खींच रहे हैं। यह एक उत्तर नहीं है, अगर आपको कोई जवाब नहीं मिलता है और छोड़ने की तरह महसूस होता है तो केवल एक सांत्वना। –