delphi - Desplazarse por TTreeView mientras arrastra sobre/cerca de los bordes

scroll

Question

Tengo un TTreeView que puede tener muchos nodos, cuando se expanden muchos nodos, el árbol usa mucho espacio en la pantalla.

Ahora supongamos que quiero arrastrar un nodo que está cerca de la parte inferior del TreeView hacia arriba, no puedo ver físicamente la parte superior de TreeView porque el nodo que estoy seleccionando está en la parte inferior. Al arrastrar el nodo a la parte superior de TreeView, me gustaría que TreeView se desplace automáticamente al arrastrar, por defecto esto no parece suceder.

Un ejemplo perfecto de este comportamiento se ve en el Explorador de Windows. Si intenta arrastrar un archivo o una carpeta, al desplazar el elemento arrastrado (nodo), se desplazará automáticamente hacia arriba o hacia abajo dependiendo de la posición del cursor.

Espero que tenga sentido.

PD, ya sé cómo arrastrar nodos, quiero que TreeView se desplace conmigo al arrastrarlo si se desplaza cerca de la parte superior o inferior de TreeView.

Gracias.

Answer 1

Aquí hay una alternativa basada en el hecho de que el nodo seleccionado siempre se desplaza automáticamente a la vista.

type
TForm1 = class(TForm)
TreeView1: TTreeView;
TreeView2: TTreeView;
procedure TreeViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure TreeViewEndDrag(Sender, Target: TObject; X, Y: Integer);
procedure TreeViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FDragNode: TTreeNode;
FNodeHeight: Integer;
end;
...
procedure TForm1.TreeViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
with TTreeView(Sender) do
begin
FDragNode := GetNodeAt(X, Y);
if FDragNode <> nil then
begin
Selected := FDragNode;
with FDragNode.DisplayRect(False) do
FNodeHeight := Bottom - Top;
BeginDrag(False, Mouse.DragThreshold);
end;
end;
end;
procedure TForm1.TreeViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
Pt: TPoint;
DropNode: TTreeNode;
begin
Accept := Source is TTreeView;
if Accept then
with TTreeView(Source) do
begin
if Sender <> Source then
Pt := ScreenToClient(Mouse.CursorPos)
else
Pt := Point(X, Y);
if Pt.Y < FNodeHeight then
DropNode := Selected.GetPrevVisible
else if Pt.Y > (ClientHeight - FNodeHeight) then
DropNode := Selected.GetNextVisible
else
DropNode := GetNodeAt(Pt.X, Pt.Y);
if DropNode <> nil then
Selected := DropNode;
end;
end;
procedure TForm1.TreeViewEndDrag(Sender, Target: TObject; X, Y: Integer);
var
DropNode: TTreeNode;
begin
with TTreeView(Sender) do
if Target <> nil then
begin
DropNode := Selected;
DropNode := Items.Insert(DropNode, '''');
DropNode.Assign(FDragNode);
Selected := DropNode;
Items.Delete(FDragNode);
end
else
Selected := FDragNode;
end;

Es posible que desee vincular el controlador de eventos OnDragOver al padre de TreeView también, lo que da como resultado desplazarse y soltar cuando el mouse está fuera de TreeView. Si desea el desplazamiento, pero no la caída cuando el mouse está fuera del TreeView, entonces verifique if Target = Sender en el manejador de eventos OnEndDrag.

Answer 2

Este es el código que uso. Funcionará para cualquier descendiente TWinControl : cuadro de lista, vista de árbol, vista de lista, etc.

type
TAutoScrollTimer = class(TTimer)
private
FControl: TWinControl;
FScrollCount: Integer;
procedure InitialiseTimer;
procedure Timer(Sender: TObject);
public
constructor Create(Control: TWinControl);
end;
{ TAutoScrollTimer }
constructor TAutoScrollTimer.Create(Control: TWinControl);
begin
inherited Create(Control);
FControl := Control;
InitialiseTimer;
end;
procedure TAutoScrollTimer.InitialiseTimer;
begin
FScrollCount := 0;
Interval := 250;
Enabled := True;
OnTimer := Timer;
end;
procedure TAutoScrollTimer.Timer(Sender: TObject);
procedure DoScroll;
var
WindowEdgeTolerance: Integer;
Pos: TPoint;
begin
WindowEdgeTolerance := Min(25, FControl.Height div 4);
GetCursorPos(Pos);
Pos := FControl.ScreenToClient(Pos);
if not InRange(Pos.X, 0, FControl.Width) then begin
exit;
end;
if Pos.Y<WindowEdgeTolerance then begin
SendMessage(FControl.Handle, WM_VSCROLL, SB_LINEUP, 0);
end else if Pos.Y>FControl.Height-WindowEdgeTolerance then begin
SendMessage(FControl.Handle, WM_VSCROLL, SB_LINEDOWN, 0);
end else begin
InitialiseTimer;
exit;
end;
if FScrollCount<50 then begin
inc(FScrollCount);
if FScrollCount mod 5=0 then begin
//speed up the scrolling by reducing the timer interval
Interval := MulDiv(Interval, 3, 4);
end;
end;
if Win32MajorVersion<6 then begin
//in XP we need to clear up transient "fluff"; results in flickering so only do it in XP where it is needed
FControl.Invalidate;
end;
end;
begin
if Mouse.IsDragging then begin
DoScroll;
end else begin
Free;
end;
end;

Luego, para usarlo, agregue un controlador de eventos OnStartDrag para el control y OnStartDrag así:

procedure TMyForm.SomeControlStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
TAutoScrollTimer.Create(Sender as TWinControl);
end;