| 
   
    | ...scroll a Treeview when Drag/Drop? |   
    | Autor: 
      Damian Gorski |  | [ Print tip 
] |  |  |  
 
 
procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);
 begin
 if (y < 15) then {On the upper edge - should scroll up }
 SendMessage(TreeView1.Handle, WM_VSCROLL, SB_LINEUP, 0)
 else if (TreeView1.Height - y < 15) then { On the lower edge - should scroll down }
 SendMessage(TreeView1.Handle, WM_VSCROLL, SB_LINEDOWN, 0);
 end;
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 ERWEITERUNG von / ENHANCEMENT sent by
 Stef Mientki (http://Punthoofd.flappie.nl)
 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
 {
 Thomas Stutz wrote a code snippet, to scroll a treeview,
 when dragging near top/bottom of a treeview.
 But with his code, you had to keep your mouse moving.
 Adding a timer, does the work for you.
 }
 ....
 private
 { Private declarations }
 scroll_down   :boolean;
 ....
 
 procedure TForm_test_list.tv_filesDragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
 (*******************************************************************************
 Start auto scroll when draging near top or bottom
 *******************************************************************************)
 begin
 if y<15 then
 begin
 scroll_down:=true;
 timer_autoscroll.Enabled:=true;
 end
 else
 if (list.Height-y)<15 then
 begin
 scroll_down:=false;
 timer_autoscroll.Enabled:=true;
 end
 else timer_autoscroll.Enabled:=false;
 end;
 
 procedure TForm_test_list.Timer_autoscrollTimer(Sender: TObject);
 (*******************************************************************************
 Set timer to about 100 msec (disabled at initialization)
 *******************************************************************************)
 begin
 if scroll_down then
 SendMessage(tv_files.Handle, WM_VSCROLL, SB_LINEUP, 0)
 else
 SendMessage(tv_files.Handle, WM_VSCROLL, SB_LINEDOWN, 0);
 end;
 
 
 
   |