델파이 끌기가 도킹으로 "승격"될 수 있습니까?

Question

TPageControl의 페이지는 모두 ManualDock()을 사용하여 첨부 된 다양한 양식입니다. 사용자는 이미 작동하는 탭을 드래그하여 다시 정렬 할 수 있어야합니다. 그러나 도킹 된 도형을 도킹 해제 할 수 있어야합니다. 그렇지 않으면 탭에 의해 재 배열 할 수 있으며, 시프트 또는 Ctrl 키 키를 누른 경우 중 하나, 다음 도킹 작업이 시작됩니다

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; 

: 나는 다음과 같은 코드가 지금은

그들을 끌고.

수정 자로 키를 사용하는 것은 어색합니다. 마우스 커서가 페이지 컨트롤의 탭 영역 밖에있을 때 활성 드래그 작업을 취소하고 하위 폼을 도킹하기 시작하는 방법이 있습니까? 이것은 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. 

편집기로이 붙여 넣기하고 실행, 필요한 모든 구성 요소와 속성 생성 및 설정됩니다 런타임시.

양식을 도킹 해제하려면 탭을 두 번 클릭해야 가능합니다. 탭과의 거리에 관계없이 마우스 왼쪽 버튼을 놓을 때까지 끌기 커서가 표시되는 것은 다소 못 생깁니다. 마우스가 몇 픽셀의 여백을두고 페이지 컨트롤 탭 영역 밖에있을 때 끌기가 자동으로 취소되고 폼이 도킹 해제되면 훨씬 더 좋습니다.

페이지 컨트롤의 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; 

이 다음 탭을 드래그 취소 할 때의 탭에서 충분히 멀리 마우스를 이동하고 만약됩니다 활성 페이지가 도킹 가능한 형식이면 도킹 작업이 시작되고 ESC 키를 사용하여 취소 할 수 있습니다.