📄 systemtreeview.pas
字号:
ParentThread := NIL;
end;
// we need to make sure that the directory we are watching hasn't been
// deleted or moved
Items.BeginUpdate;
try
dir := GetNodePath(WatchedNode);
if dir = '' then exit;
if not DirectoryExists(dir) then
begin
if FileExists(dir) then // is it file that the user selected?
WatchDirectoryForChanges(WatchedNode.Parent)
else begin
Temp := WatchedNode.Parent;
TExpanded := Temp.Expanded;
ResetNode(Temp);
if TExpanded then
begin
Temp.Expand(False);
Temp.MakeVisible;
end;
Selected := Temp;
end;
end else begin
Temp := WatchedNode;
TExpanded := Temp.Expanded;
WatchedNode := NIL;
ResetNode(Temp);
if TExpanded then
begin
Temp.Expand(False);
Temp.MakeVisible;
end;
WatchDirectoryForChanges(Temp);
end;
finally
Items.EndUpdate;
end;
end;
procedure TdfsSystemTreeView.ParentThreadDone(Sender: TObject);
begin
ParentThread := NIL;
// Check to see if the directory currently selected has been deleted or renamed
if not DirectoryExists(GetNodePath(WatchedNode)) then
begin
Selected := ParentWatchedNode;
Reset;
end;
end;
{$ENDIF}
function TdfsSystemTreeView.GetNodePath(const Node: TTreeNode): string;
begin
Result := '';
if (Node <> NIL) and (Node.Data <> NIL) then
begin
SetLength(Result, MAX_PATH);
if SHGetPathFromIDList(GetNodeData(Node).FQ_IDList, PChar(Result)) then
SetLength(Result, StrLen(PChar(Result)))
else
Result := '';
end;
end;
procedure TdfsSystemTreeView.Change(Node: TTreeNode);
var
OldCursor : TCursor;
begin
if FDestroyingSelf then
exit;
OldCursor := Cursor;
Cursor := crHourglass;
inherited Change(Node);
{$IFDEF DFS_STV_FILECHANGES}
if (ReadDelay < 1) and (Selected <> NIL) and (Selected.Data <> NIL) then
WatchDirectoryForChanges(Selected);
{$ENDIF}
Cursor := OldCursor;
end;
procedure TdfsSystemTreeView.DoStartDrag(var DragObject: TDragObject);
begin
inherited DoStartDrag(DragObject);
// DoDragDrop
end;
function TdfsSystemTreeView.RenameNode(const Node: TTreeNode;
const NewName: string): boolean;
var
pstr: PWideChar;
AnIDList: PItemIDList;
begin
Result := FALSE;
if (Node = NIL) or (Node.Data = NIL) or (NewName = '') then exit;
pstr := StringToOleStr(NewName); //make an OLE string for SetNameOf
try
with GetNodeData(Node) do
begin
AnIDList := CreatePIDL(1);
// SetNameOf will free the first IDList passed and return the new IDList
// in the second PIDL parameter.
Result := SUCCEEDED(SFParent.SetNameOf(GetValidHandle, IDList, pstr,
SHCONTF_FOLDERS, AnIDList));
if Result then
begin
Node.Text := NewName;
IDList := AnIDList;
if (assigned(Node.Parent) and (assigned(Node.Parent.Data))) then
FQ_IDList := ConcatPIDLS(TFolderItemData(Node.Parent.Data).FQ_IDList,
IDList)
else
FQ_IDList := ConcatPIDLs(NIL, IDList);
end;
end;
finally
ShellMalloc.Free(pstr); // Don't forget to free the OLE string
end;
end;
function TdfsSystemTreeView.DeleteNode(const Node: TTreeNode): boolean;
var
ItemData: TFolderItemData;
begin
Result := FALSE;
ItemData := GetNodeData(Node);
if (ItemData <> NIL) and (ItemData.IDList <> NIL) then
(*
Dir := GetNodePath(Node);
if Dir = '' then exit;
Result := RemoveDirectory(PChar(Dir));
if Result then
DeleteItem(Node);
*)
{$IFDEF DFS_COMPILER_4_UP}
Result := ItemProp.PerformVerb('delete', ItemData.SFParent, ItemData.FIDList,
ItemData.Attributes, DFS_HWND(Handle), 1);
{$ELSE}
Result := ItemProp.PerformVerbPIDL('delete', ItemData.SFParent,
ItemData.FIDList, ItemData.Attributes,
{$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, 1);
{$ENDIF}
end;
function TdfsSystemTreeView.AddNewNode(const ParentNode: TTreeNode;
const NodeName: string; SelectNewNode: boolean): boolean;
var
Dir: string;
Temp: TTreeNode;
begin
Result := FALSE;
Dir := GetNodePath(ParentNode);
if (Dir = '') or (NodeName = '') then exit; // only add to file system nodes.
if Dir[Length(Dir)] <> '\' then
Dir := Dir + '\';
Dir := Dir + NodeName;
{$IFDEF DFS_STV_FILECHANGES}
// Turn off the file change thread.
Temp := NIL;
if FCThread <> NIL then
begin
Temp := WatchedNode;
WatchedNode:= NIL;
FCThread.Terminate;
FCThread := NIL;
end;
if ParentThread <> NIL then
begin
ParentWatchedNode := NIL;
ParentThread.Terminate;
ParentThread := NIL;
end;
{$ENDIF}
Result := CreateDirectory(PChar(Dir), NIL);
if Result then
begin
ResetNode(ParentNode);
if SelectNewNode then
begin
Temp := ParentNode.GetFirstChild;
while assigned(Temp) do
begin
if Temp.Text = NodeName then
begin
Selected := Temp;
break; // We're done
end;
Temp := Temp.GetNextSibling;
end;
{$IFDEF DFS_STV_FILECHANGES}
Temp := NIL; // Changing Selected will restart the watch.
{$ENDIF}
end;
end;
{$IFDEF DFS_STV_FILECHANGES}
if Temp <> NIL then
WatchDirectoryForChanges(Temp);
{$ENDIF}
end;
function TdfsSystemTreeView.GetVersion: string;
begin
Result := DFS_COMPONENT_TREE_VERSION;
end;
procedure TdfsSystemTreeView.SetVersion(const Val: string);
begin
{ empty write method, just needed to get it to show up in Object Inspector }
end;
(*******************************************************************************
Computes if tree must be moved up or down, left or right, depending on mouse
position.
*******************************************************************************)
procedure TdfsSystemTreeView.Compute_TreeMoves(X, Y: integer);
var
NbPixels: Integer;
RMin, RMax: Integer;
HOffset,
VOffset: Integer;
begin
// Comments by Aristide Torrelli
{--------------------------------------------------------------------}
{ Algorithm : }
{ ----------- }
{ . Detect scroll bars (horizontal and/or vertical) to set offsets }
{ . If mouse is near upper edge or lower edge, scroll the control to }
{ up or down by one line }
{ . If mouse is near left or right edge, scroll the control to one }
{ page left or one page right }
{--------------------------------------------------------------------}
if not FAutoscroll then exit;
{--------------------------------------------------------------------}
{ Retrieve the scroll bar ranges, if such scroll bars exist (either }
{ horizontal or vertical). An offset must be set if there is a }
{ scroll bar, i-e if there is a range (RMin <> RMax). }
{--------------------------------------------------------------------}
GetScrollRange(Handle, SB_HORZ, RMin, RMax);
if RMin = RMax then
HOffset := 0
else
HOffset := 16;
GetScrollRange(Handle, SB_VERT, RMin, RMax);
If RMin = RMax then
VOffset := 0
else
VOffset := 16;
{--------------------------------------------------------------------}
{ Near an edge means at a maximum of (half) a line, i-e half the }
{ pixles of the current font. }
{--------------------------------------------------------------------}
NbPixels := Abs((Font.Height));
if (Y < NbPixels) then
Perform(WM_VSCROLL, SB_LINEUP, 0)
else if (Y > Height - VOffset - NbPixels) then
Perform(WM_VSCROLL, SB_LINEDOWN, 0);
if (X < NbPixels ) then
Perform(WM_HSCROLL, SB_LINELEFT, 0)
else if (X > Width - HOffset - NbPixels) then
Perform(WM_HSCROLL, SB_LINERIGHT, 0);
end;
procedure TdfsSystemTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if FAutoScroll then
Compute_TreeMoves( X, Y );
inherited MouseMove( Shift, X, Y );
end;
procedure TdfsSystemTreeView.Populated(Node: TTreeNode);
begin
if assigned(FOnPopulated) then
FOnPopulated(Self, Node);
end;
// Implementation must return the actual ID list. Caller will make a copy
// of it it wants it's own. Implementer owns this one, i.e. it's the "real
// thing". If there isn't one, return NIL.
function TdfsSystemTreeView.GetSelectionPIDL: PItemIDList;
begin
if (Selected <> NIL) and (Selected.Data <> NIL) then
Result := NodeData[Selected].FQ_IDList
else
Result := NIL;
end;
function TdfsSystemTreeView.GetSelectionParentFolder: IShellFolder;
begin
Result := FDesktopFolder;
(*
if (Selected <> NIL) and (Selected.Data <> NIL) then
Result := NodeData[Selected].SFParent
else
Result := NIL;
*)
end;
// Implementation notes: IDList parameter belongs to someone else. If
// needed by this component, a copy must be made of it. This differs from
// the Reset method in that it does not notify linked controls of a change
// because that could result in an endless cycle of notifications. Return
// value indicates success or failure.
function TdfsSystemTreeView.LinkedReset(const ParentFolder: IShellFolder;
const IDList: PItemIDList; ForceUpdate: boolean): boolean;
var
FindID: PItemIDList;
begin
// This method is not intended for general purpose use. It makes some
// assumptions about what is being passed, and if those aren't valid then
// it won't work (or worse). Internal use only!
Result := FALSE;
//!!! May need to treat NIL IDList as a root selection.
if (IDList <> NIL) then
begin
// Adjust for the lack of a "Desktop" node since FQ pidls do include it.
if RootFolder in [rfFileSystem, rfDrives] then
FindID := NextPIDL(IDList) // Move to the next ID in the list
else
FindID := IDList;
Selected := FindNodeFromID(FindID);
if Selected <> NIL then
Selected.MakeVisible;
end;
(* This is the old code for listview resets...
Node := Selected;
if (IDList <> NIL) and (Items.Count > 0) and (Node <> NIL) and
(Node.Data <> NIL) then
begin
if not Node.Expanded then
Node.Expand(FALSE);
if TFolderItemData(Node.Data).IDList = IDList then exit;
Node := Node.GetFirstChild;
while Node <> NIL do
begin
if Node.Data <> NIL then
if ComparePIDLs(TFolderItemData(Node.Data).IDList, IDList) then
begin
// Found it!
Selected := Node;
Result := TRUE;
break;
end;
Node := Node.GetNextSibling;
end;
end;
*)
end;
{$IFDEF DFS_SCP_SYSCOMBOBOX}
procedure TdfsSystemTreeView.ComboBoxSetSelectionPIDL(APIDL: PItemIDList);
var
HoldIDlist: TList;
TempPIDL, FindID: PItemIDList;
Node, ChildNode: TTreeNode;
x: integer;
begin
Node := Selected;
if (APIDL <> NIL) and (Items.Count > 0) and (Node <> NIL) and
(Node.Data <> NIL) then
begin
// take the PIDL passed and strip every ItemFrom it and add it to a list
HoldIDList := TList.Create;
try
FindID := CopyPIDL(APIDL);
while (FindID.mkid.cb <> 0) do
begin
//Add this id to the list
HoldIDList.Add(CopyPidl(FindID));
TempPIDL := CopyParentPIDL(FindID);
FreePIDL(FindID);
FindID := TempPIDL;
end;
HoldIDList.Add(FindID);
//Now the last Item in the list should be the desktop.
if ComparePIDLs(TFolderItemData(Items[0].Data).FQ_IDList,
PItemIDList(HoldIDlist.Items[HoldIDList.Count-1])) then
begin
// yup the last item is the desktop!
Node:=Items[0];
// now start expanding the tree until we find the item passed
for x := HoldIDList.Count-2 downto 0 do
begin
Node.Expand(False);
ChildNode
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -