Delphi'yi sürükleme takma için "yükseltilebilir" olabilir mi?

Question

Ben Sayfalarını ManualDock() kullanılarak ekli olan tüm değişik şekilleridir bir TPageControl. Kullanıcı, sekmeleri sürükleyerek yeniden düzenleyebilmeli, zaten çalışıyor. Bununla birlikte, sabitlenmiş formların çıkarılması da mümkün olmalıdır. Aksi sekmeler tarafından yeniden düzenlenebilir, Shift veya Ctrl tuşu basılı tutulur ya, o zaman yerleştirme işlemi başlatılır ise

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; 

: Aşağıdaki kodu var Şimdilik

onları sürükleyerek. düzenleyiciler olsa garip olarak tuşlarını kullanarak

. Fare imleci, sayfa kontrolünün sekme alanının dışında olduğunda etkin sürükleme işlemini iptal etmenin ve alt formu yerleştirmeye başlamanın herhangi bir yolu var mı? Bu benim için çalıştığı artık bir çözüm var, bu yüzden kendim cevap verecek Delphi 2009.

Answer 1

ile - belki biri de bunun için bir kullanımı vardır.

Sekmelerin çalışma zamanının yeniden düzenlenmesine izin vermek için kodla birlikte 8 takılı formlu bir TPageControl oluşturan küçük bir örnek uygulama ile başlayalım. Sekmeler canlı taşınacak ve sürükleme iptal edildiğinde aktif sekme dizini orijinal değerine geri döner:

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. 

editörü yapıştırın ve çalıştırın, gerekli tüm bileşenleri ve özellikleri oluşturulan ve kurulacak çalışma zamanında. formlarını çıkarılmasını

Not sadece çift tıklayarak sekmelerin mümkündür. Ayrıca, sürükleme imlecinin, sekmelerden uzaklığa bakılmaksızın, sol fare düğmesi serbest bırakılıncaya kadar gösterileceği de biraz çirkin. Fare, birkaç piksel kenar boşluğu olan sayfa kontrol sekmesi alanının dışında olduğunda, sürükleme otomatik olarak iptal edildiyse ve form bunun yerine kaldırılsa çok daha iyi olurdu.

Bu, sayfa denetiminin OnStartDrag işleyicisinde bir özel DragObject oluşturarak sağlanabilir. Bu nesnede fare yakalanır, böylece sürüklenirken tüm fare mesajları içinde ele alınabilir. fare imlecini dikdörtgen sekme etkisi dışında olduğunda sürükleme iptal edilir, ve aktif sayfa kontrol sayfasında bir form için bir yerleştirme işlemi yerine başlatılır:

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; 

sınıfı TDragControlObjectEx yerine kadar TDragControlObject iner otomatik olarak serbest bırakılacak. Şimdi örnek uygulamada TPageControl için bir işleyici oluşturuldu (ve sayfa denetimi nesne için ayarlanmış) ise:

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; 

sonra sekme sürükleme iptal zaman sekmelerin yeteri kadar uzaklaşması fare hareket eder ve eğer edilecek aktif sayfa hala ESC anahtarla iptal edilebilir sonra bunun için bir yerleştirme işlemi başlatılır bir dock biçimidir.