Delphi có thể kéo được "quảng cáo" để kết nối không?

Question

Tôi có một trang TPageControl có tất cả các trang được đính kèm bằng cách sử dụng ManualDock(). Người dùng có thể sắp xếp lại các tab bằng cách kéo chúng, hoạt động đã sẵn sàng. Tuy nhiên nó cũng có thể để hoàn tác các hình thức docked.

Để bây giờ tôi đã đoạn mã sau:

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; 

Nếu một trong hai phím Shift hay Ctrl trọng được tổ chức xuống, sau đó một hoạt động docking sẽ được bắt đầu, nếu không các tab có thể được sắp xếp lại bằng cách kéo chúng.

Sử dụng các phím làm công cụ sửa đổi là khó xử. Có cách nào để hủy hoạt động kéo hoạt động khi con trỏ chuột nằm ngoài khu vực tab của điều khiển trang và bắt đầu gắn vào biểu mẫu con không? Điều này là với Delphi 2009.

Answer 1

Tôi có một giải pháp bây giờ mà làm việc cho tôi, vì vậy tôi sẽ trả lời bản thân mình - có lẽ ai đó có một sử dụng cho điều này quá.

Hãy bắt đầu với một ứng dụng mẫu nhỏ tạo ra một TPageControl với 8 biểu mẫu được gắn với mã để cho phép sắp xếp lại thời gian của các tab. Tabs sẽ được chuyển trực tiếp, và khi kéo bị hủy chỉ số tab hoạt động sẽ trở lại giá trị ban đầu của nó:

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. 

Dán này vào trình soạn thảo và chạy nó, tất cả các thành phần cần thiết và tài sản của họ sẽ được tạo ra và thiết lập vào thời gian chạy.

Lưu ý rằng việc hoàn tác các biểu mẫu chỉ có thể bằng cách nhấp đúp vào các tab. Nó cũng hơi xấu xí khi con trỏ kéo sẽ được hiển thị cho đến khi nút chuột trái được nhả ra, bất kể khoảng cách từ các tab. Sẽ tốt hơn nếu thao tác kéo tự động bị hủy và biểu mẫu sẽ được bỏ khóa thay vào đó, khi con chuột ở bên ngoài vùng tab điều khiển trang với một chút lề pixel.

Điều này có thể đạt được bằng cách tạo tùy chỉnh DragObject trong trình xử lý trang OnStartDrag. Trong đối tượng này con chuột bị bắt, vì vậy tất cả các tin nhắn chuột trong khi kéo có thể được xử lý trong đó. Khi con trỏ chuột nằm ngoài sự ảnh hưởng tab hình chữ nhật kéo bị hủy bỏ, và một thao tác lắp ghép cho các hình thức trong bảng kiểm soát trang chủ động được bắt đầu thay:

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; 

Lớp xuống từ TDragControlObjectEx thay vì từ TDragControlObject nên rằng nó sẽ tự động được giải phóng. Bây giờ nếu một handler cho TPageControl trong việc áp dụng mẫu được tạo ra (và thiết lập cho đối tượng kiểm soát trang):

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; 

thì kéo tab sẽ bị hủy bỏ khi di chuyển chuột đủ xa từ các tab, và nếu trang đang hoạt động là biểu mẫu có thể gắn kết, sau đó thao tác gắn cho nó sẽ được bắt đầu, thao tác này vẫn có thể bị hủy bằng khóa ESC.