Прокрутите TTreeView, перетаскивая его / около краев - PullRequest
Новая
       16

Прокрутите TTreeView, перетаскивая его / около краев

8 голосов
/ 05 июня 2011

У меня есть TTreeView, который может иметь много узлов, когда много узлов расширяется, дерево занимает много места на экране.

Теперь предположим, что я хочу перетащить узел, который находится в нижней частиTreeView наверх, я не могу физически увидеть верхнюю часть TreeView, потому что узел, который я выбираю, находится внизу.При перетаскивании узла в верхнюю часть TreeView я бы хотел, чтобы TreeView автоматически перетаскивал меня при перетаскивании, по умолчанию этого не происходит.

Прекрасный пример такого поведения можно увидеть в проводнике Windows.Если вы попытаетесь перетащить файл или папку, при наведении мыши на перетаскиваемый элемент (узел) он автоматически прокручивается вверх или вниз в зависимости от положения курсора.

Надеюсь, что это имеет смысл.

PS, IЯ уже знаю, как перетаскивать узлы, я хочу, чтобы TreeView прокручивался вместе со мной при перетаскивании, если он завис над верхней или нижней частью TreeView.

Спасибо.

Ответы [ 2 ]

11 голосов
/ 05 июня 2011

Это код, который я использую.Он будет работать для любого потомка TWinControl: списка, дерева, списка и т. Д. 

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;

Затем, чтобы использовать его, вы добавляете обработчик события OnStartDrag для элемента управления и реализуете его следующим образом:

procedure TMyForm.SomeControlStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  TAutoScrollTimer.Create(Sender as TWinControl);
end;
1 голос
/ 05 июня 2011

Вот альтернатива, основанная на том факте, что выбранный узел всегда автоматически прокручивается в представлении. 

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;

Вы можете хотеть связать обработчик события OnDragOver и с родительским элементом TreeView, что приводит к прокрутке и удалению, когда мышь находится вне TreeView. Если вы хотите прокручивать, но не отбрасывать, когда мышь находится вне TreeView, отметьте if Target = Sender в обработчике события OnEndDrag.

...