Il trascinamento di Delphi può essere "promosso" all'aggancio?

Question

Ho un TPageControl le cui pagine sono tutti i vari moduli che sono collegati utilizzando ManualDock(). L'utente dovrebbe essere in grado di riorganizzare le schede trascinandole, il che funziona già. Dovrebbe tuttavia anche essere possibile sganciare i moduli ancorati.

Per ora ho il seguente codice:

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; 

Se sia il Maiusc o la chiave Ctrl sono premuti, quindi verrà avviata un'operazione di attracco, altrimenti le schede possono essere riorganizzate trascinandoli.

L'uso dei tasti come modificatori è tuttavia scomodo. Esiste un modo per annullare l'operazione di trascinamento attiva quando il cursore del mouse si trova al di fuori dell'area della scheda del controllo della pagina e avviare l'ancoraggio del modulo figlio? Questo è con Delphi 2009.

Answer 1

Ho una soluzione ora che funziona per me, quindi mi risponderò - forse qualcuno ha un uso anche per questo.

Iniziamo con una piccola applicazione di esempio che crea uno TPageControl con 8 moduli ancorati, con codice per consentire il riordino in runtime delle schede. Schede verranno spostati dal vivo, e quando il trascinamento è cancellata indice scheda attiva tornerà al suo valore originale:

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. 

incollare questo nell'editor ed eseguirlo, tutti i componenti necessari e le loro proprietà saranno creati e impostare fino a runtime.

Si noti che sganciare i moduli è possibile solo facendo doppio clic sulle schede. È anche un po 'brutto che il cursore di trascinamento verrà mostrato fino a quando il pulsante sinistro del mouse viene rilasciato, indipendentemente dalla distanza dalle schede. Sarebbe molto meglio se il trascinamento fosse automaticamente annullato e il modulo fosse sganciato invece, quando il mouse si trova al di fuori dell'area della scheda di controllo della pagina con un margine di alcuni pixel.

Questo può essere ottenuto creando un numero personalizzato DragObject nel gestore OnStartDrag del controllo pagina. In questo oggetto viene catturato il mouse, quindi tutti i messaggi del mouse durante il trascinamento possono essere gestiti in esso. Quando il cursore del mouse è fuori della scheda influenza rettangolo il trascinamento viene annullato, ed un'operazione di aggancio per la forma del foglio di controllo pagina attiva viene avviato invece:

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; 

La classe discende da TDragControlObjectEx anziché da TDragControlObject così che verrà automaticamente liberato. Ora, se si crea un gestore per il TPageControl nell'applicazione di esempio (e impostare per l'oggetto di controllo pagina):

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; 

quindi la scheda trascinamento viene cancellata quando il mouse si muove abbastanza lontano dalle schede, e se la pagina attiva è una forma agganciabile, quindi verrà avviata un'operazione di ancoraggio, che può ancora essere annullata con la chiave ESC.