[轉貼]請問如何在拖曳時,可以使滑鼠往上或往下超過視窗時,該treeview可以自動捲動??

[tim]

在 TreeView.OnDragOver 事件中這樣寫

代碼: 選擇全部

     
    procedure TfmTreeFun.TreeView1DragOver(Sender, Source: TObject; X, 
      Y: Integer; State: TDragState; var Accept: Boolean); 
    var 
      i, j: Integer; 
      Pt: TPoint; 
    begin 
      while (Y > TreeView1.Height - GetSystemMetrics(SM_CYHSCROLL) - 5) 
        and (Y <= TreeView1.Height) do 
      begin 
        GetCursorPos(Pt); 
        Pt := ScreenToClient(Pt); 
        Y := Pt.y; 
        i := TreeView1.TopItem.AbsoluteIndex; 
        j := 1; 
        while (i + j <= TreeView1.Items.Count) and (TreeView1.Items[i + j].Parent <> nil) and (not TreeView1.Items[i + j].Parent.Expanded) do j := j + 1; 
        TreeView1.TopItem := TreeView1.Items[i + j]; 
        TreeView1.RePaint; 
        if i = TreeView1.TopItem.AbsoluteIndex then Break; 
      end; 
     
      while (Y < 20) and (Y >= 0) do 
      begin 
        GetCursorPos(Pt); 
        Pt := ScreenToClient(Pt); 
        Y := Pt.y; 
        i := TreeView1.TopItem.AbsoluteIndex; 
        j := 1; 
        while (i - j >= 0) and (TreeView1.Items[i - j].Parent <> nil) and (not TreeView1.Items[i - j].Parent.Expanded) do j := j + 1; 
        if i > 0 then 
        begin 
          TreeView1.TopItem := TreeView1.Items[i - j]; 
          TreeView1.RePaint; 
        end; 
        if i = 0 then Break; 
      end; 
    end;