拖放時功能： 

1. 要拖放到未展開節點的子節點上時，滑鼠停在要展開的節點一會兒，會自動展開
   
2. 要拖放到超過目前顯示範圍時，會自動捲動
   
3. 禁止拖放到自己的子節點上
   

將 DragMode 屬性設定為 dmAutomatic 撰寫事件程式如下：
<textarea cols="80" rows="130" class="delphi" name="code"> procedure TfmERingNG.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
AnItem: TTreeNode;
i, j, iBegin, iEnd, iLevel: Integer;
Pt: TPoint;
StartTime, EndTime: TDateTime;
begin
if TreeView1.Selected = nil then
Exit;
iBegin := TreeView1.Selected.AbsoluteIndex;
iLevel := TreeView1.Selected.Level;
i := iBegin;
while i < TreeView1.Items.Count - 1 do
begin
i := i 1;
if TreeView1.Items[i].Level <= iLevel then
Break;
end;
if i <= TreeView1.Items.Count - 1 then
iEnd := i - 1
else
iEnd := i;
AnItem := TreeView1.GetNodeAt(X, Y);
Accept := (Source = TreeView1)
and (AnItem <> nil)
and not ((AnItem.AbsoluteIndex >= iBegin)
and (AnItem.AbsoluteIndex <= iEnd));
if AnItem = nil then
Exit;
if not AnItem.Expanded and AnItem.HasChildren then
begin
if (State = dsDragMove) and AnItem.DropTarget then
begin
StartTime := Now;
GetCursorPos(Pt);
Pt := ScreenToClient(Pt);
TreeView1.RePaint;
while AnItem = TreeView1.GetNodeAt(Pt.x, Pt.y) do
begin
GetCursorPos(Pt);
Pt := ScreenToClient(Pt);
if Now - StartTime > 0.000001 then
Break;
end;
EndTime := Now;
if EndTime - StartTime > 0.000001 then
begin
AnItem.Expand(False);
TreeView1.RePaint;
end;
end;
end;
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;
Sleep(50);
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;
Sleep(50);
end;
end;

procedure TfmERingNG.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
AnItem: TTreeNode;
AttachMode: TNodeAttachMode;
HT: THitTests;
begin
if TreeView1.Selected = nil then
Exit;
HT := TreeView1.GetHitTestInfoAt(X, Y);
AnItem := TreeView1.GetNodeAt(X, Y);
if AnItem = nil then
Exit;
if (HT - [htOnItem, htOnRight, htOnIcon, htNowhere, htOnIndent] <> HT) then
begin
AttachMode := naInsert;
if (htOnItem in HT)
or (htOnRight in HT) or (htOnIcon in HT) then
AttachMode := naAddChild
else if htNowhere in HT then
AttachMode := naAdd
else if htOnIndent in HT then
AttachMode := naInsert;
TreeView1.Selected.MoveTo(AnItem, AttachMode);
end;
end;

</textarea>

------
歡迎參訪 "腦殘賤貓的備忘錄" http://maolaoda.blogspot.com/

編輯記錄

這內容太經典

推一下！

我也推一下
===================引 用 GrandRURU 文 章===================
這內容太經典

推一下！

感謝分享! 大家來襄盛舉吧!
好久沒看到 sryang兄了!

編輯記錄

------
歡迎參訪 "腦殘賤貓的備忘錄" http://maolaoda.blogspot.com/