⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 systemtreeview.pas

📁 动态提示控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    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 + -