|
//问题描述见 howto 一文，代码最终版本见下文 //标红色部分为解决问题的关键 //标蓝色部分为datatree所要求的，即前文提供的解决方案，但并不奏效 procedure TScriptProperty.DataTreeDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
pnode2: PAdminNode;
data: PInt;
Node2: PVirtualNode;
sql: string; changeList: TStringList;
FocusNode: PVirtualNode;
TargetNode: PVirtualNode;
Temp:PVirtualNode;
i: Integer;
left,right,targe:Integer;
begin
Effect := DROPEFFECT_NONE;
if (Source is TBaseVirtualTree) then
begin
Node2 := (Source as TBaseVirtualTree).GetFirstSelected;
data := (Source as TBaseVirtualTree).GetNodeData(Node2);
pnode2 := Pointer(data^); FocusNode := Sender.GetFirstSelected;
TargetNode := Sender.DropTargetNode; left :=LeftBracketIndex(FocusNode);
right:=RightBracketIndex(FocusNode);
if TargetNode <> nil then
targe := TargetNode.Index
else
targe := -1;
if (Source as TBaseVirtualTree).Name = ''''DataTree'''' then
begin
if DataTree.DropTargetNode = nil then Exit;
if DataTree.DropTargetNode.Index = 0 then Exit;
changeList := TStringList.Create; DataTree.BeginUpdate; //块拖动问题 if (left<>0) and (right<>0)and (left<>LeftBracketIndex(TargetNode))and (right <>RightBracketIndex (TargetNode)) then //后两个条件解决了同一块类不能移动的问题
begin
if right< targe then
begin
if (LeftStr(stringlist.Strings[targe],5)=''''While'''') or (LeftStr(stringlist.Strings[targe],3)=''''for'''') then
Exit;
for i:=right+ 1 to targe do
changeList.Add(stringlist.Strings[i]);
for i:=left-1 to right do
changeList.Add(stringlist.Strings[i]);
for i:=left-1 to targe do
stringlist.Strings[i]:= changeList.Strings[i-left+1];
end; if (left-1)> targe then
begin
if (stringlist.Strings[targe]=''''{'''') then
exit;
for i:=left-1 to right do
changeList.Add(stringlist.Strings[i]);
for i:=targe to left-2 do
changeList.Add(stringlist.Strings[i]);
for i:=targe to right do
stringlist.Strings[i]:= changeList.Strings[i-targe];
end;
end
else
begin
if FocusNode.Index > TargetNode.Index then
begin
if (stringlist.Strings[TargetNode.Index]=''''{'''') then
exit;
changeList.Add(stringlist.Strings[FocusNode.index]);
for i:=TargetNode.Index to FocusNode.Index-1 do
changeList.Add(stringlist.Strings[i]);
for i:=TargetNode.Index to FocusNode.Index do
stringlist.Strings[i]:= changeList.Strings[i-TargetNode.Index];
end; //行拖动问题 if FocusNode.Index < TargetNode.Index then
begin
if (LeftStr(stringlist.Strings[TargetNode.Index],5)=''''While'''') or (LeftStr(stringlist.Strings[TargetNode.Index],3)=''''for'''') then
Exit;
for i:=FocusNode.Index+1 to targetnode.Index do
changeList.add(stringlist.Strings[i]);
changeList.Add(stringlist.Strings[FocusNode.index]);
for i:=FocusNode.Index to TargetNode.Index do
stringlist.Strings[i]:= changeList.Strings[i-FocusNode.Index];
end;
end;
changeList.Free;
DataTree.EndUpdate;
DataTree.Clear; //只加了这行代码就解决了！原理：重画了整个树，就不存在width cach的问题了
self.DataTree.RootNodeCount:=stringlist.Count;
DataTree.Refresh;
Exit;
end
else if pnode2.typename = ''''MobileUserAgent'''' then
begin
if targe > 0 then
stringlist.Insert(targe, CreateUserAgentCode(pnode2.data))
else
stringlist.Append(CreateUserAgentCode(pnode2.data));
self.DataTree.RootNodeCount:=stringlist.Count;
DataTree.Refresh;
Exit;
end //脚本拖动问题
else
begin
if application.MessageBox(''''Are you sure to replace current script?'''', ''''Message'''', MB_OKCANCEL) = IDCancel then
exit; sql := ''''Select texts from systemobjects where itemid='''''''''''' + pnode2.id + '''''''''''''''';
currentdatabase.ExeuteSQlQurey(pnode2, sql, @GetScriptFromDB);
Self.SetScript(pnode2.texts);
Exit;
end;
end;
end; 『绝对原创 飞飞于北京 2005-08-31』
没有相关教程
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
