systemtreeview.pas

动态提示控件

            GetNormalAndSelectedIcons(FQ_IDList, N, S);
            if (S = 0) and (N <> 0) then
              S := N;
            if (mask and TVIF_IMAGE) <> 0 then
            begin
              if (Attributes and SFGAO_FOLDER) = 0 then
                iImage := S
              else
                iImage := N;
            end;
            if (mask and TVIF_SELECTEDIMAGE) <> 0 then
              iSelectedImage := S;
            CallInh := FALSE;
          end;

          // Don't ask for it again!
          mask := mask or TVIF_DI_SETITEM;
        end;
      end;
    end;
  end;


  if CallInh then
{$ENDIF}
    inherited;
end; {CNNotify}

procedure TdfsSystemTreeView.TimerEvent;
begin
  inherited TimerEvent;
{$IFDEF DFS_STV_FILECHANGES}
  WatchDirectoryForChanges(Selected);
{$ENDIF}
end;


(*******************************************************************************
  CanExpand:
*******************************************************************************)
function TdfsSystemTreeView.CanExpand(Node: TTreeNode): boolean;
var
  SubFolder: IShellFolder;
  NodeData: TFolderItemData;
begin
  Result := inherited CanExpand(Node);
  if not Result then exit;

  // See if the node needs to be populated.
  if Node.Data <> NIL then
  begin
    NodeData := GetNodeData(Node);
    if not NodeData.Initialized then
    begin
      if (Node.Parent = NIL) and (FRootFolder = rfDesktop) then
      begin
        EnumerateFolders(FDesktopFolder, Node);
        NodeData.Initialized := TRUE;
      end else begin
        OLECheck(NodeData.SFParent.BindToObject(NodeData.IDList, NIL,
           IID_IShellFolder, pointer(SubFolder)));
        // I can't remember why I do this first here, unlike above.
        NodeData.Initialized := TRUE;
        Result := EnumerateFolders(SubFolder, Node);
        {$IFNDEF DFS_NO_COM_CLEANUP} SubFolder.Release; {$ENDIF}
      end; //if
    end; //if
  end; //if

  // This usually happens on networked stuff.  It's not unusual there, and even
  // Explorer does it this way, so I'm guessing I'm doing it right.  :)
  if not Result then // something happened and we couldn't enum folders.
    Node.HasChildren := FALSE
  else
    Populated(Node);
end; {CanExpand}


(*******************************************************************************
  DeleteItem:
*******************************************************************************)
procedure TdfsSystemTreeView.DeleteItem(Node: TTreeNode);
begin
  if Node = NIL then exit;
  FreeItemData(Node);
  Node.Delete;
end; {DeleteItem}


function TdfsSystemTreeView.GetNodeFromItem(const Item: TTVItem): TTreeNode;
begin
  with Item do
    if (state and TVIF_PARAM) <> 0 then
      Result := Pointer(lParam)
    else
      Result := Items.GetNode(hItem);
end;


function TdfsSystemTreeView.GetFolderID: integer;
const
  CSIDL_CUSTOM  = $EAFE;
  FOLDERID : array[rfDesktop..rfCustom] of integer = (
     CSIDL_DESKTOP, CSIDL_BITBUCKET, CSIDL_CONTROLS, CSIDL_DESKTOPDIRECTORY,
     CSIDL_DRIVES, CSIDL_FAVORITES, CSIDL_FONTS, CSIDL_NETWORK, CSIDL_NETHOOD,
     CSIDL_PERSONAL, CSIDL_PRINTERS, CSIDL_PROGRAMS, CSIDL_RECENT, CSIDL_SENDTO,
     CSIDL_STARTMENU, CSIDL_STARTUP, CSIDL_TEMPLATES, CSIDL_DRIVES, CSIDL_CUSTOM
   );
begin
  Result := FOLDERID[FRootFolder];
end;


function TdfsSystemTreeView.GetItems: TTreeNodes;
begin
  Result := inherited Items;
end;


procedure TdfsSystemTreeView.SetShowFiles(Val: boolean);
begin
  if Val = FShowFiles then exit;
  FShowFiles := Val;
  Reset;
end;

procedure TdfsSystemTreeView.SetFileMask(const Val: string);
begin
  if Val = FFileMask then exit;
  FFileMask := Val;
  MaskSearch.BuildMask(FFileMask, FFileMaskList);
  Reset;
end;

procedure TdfsSystemTreeView.SetCustomDir(const Val: string);
begin
  if Val = FCustomDir then exit;
  FCustomDir := Val;
  Reset;
end;


procedure TdfsSystemTreeView.SetCustomDirCaption(const Val: string);
begin
  if FCustomDirCaption = Val then exit;
  FCustomDirCaption := Val;
  if Items.Count > 0 then
    Items[0].Text := FCustomDirCaption;
end;

procedure TdfsSystemTreeView.RestoreChecks;
begin
  // Unimplemented
end;

procedure TdfsSystemTreeView.SaveChecks;
begin
  // Unimplemented
end;

procedure TdfsSystemTreeView.SetCheckboxes(Val: boolean);
begin
  if Val <> FCheckboxes then
  begin
    FCheckboxes := Val;
    if HandleAllocated then
    begin
      RecreateWnd;
      if FCheckboxes then RestoreChecks;
    end;
  end;
end;

function TdfsSystemTreeView.GetIDFromPath(const ShellFolder: IShellFolder;
   const APath: string; var ID: PItemIDList): boolean;
var
  OLEStr: array[0..MAX_PATH] of TOLEChar;
  Eaten: ULONG;
  Attr: ULONG;
begin
  try
    Result := TRUE;
    OLECheck(ShellFolder.ParseDisplayName(GetValidHandle, NIL,
       StringToWideChar(APath, OLEStr, MAX_PATH), Eaten, ID, Attr));
  except
    Result := FALSE;
  end;
end;


(*******************************************************************************
  ResetTreeView:
*******************************************************************************)
procedure TdfsSystemTreeView.Reset;
var
  RootNode: TTreeNode;
  RootID: PItemIDList;
  Success: boolean;
  FindID,
  CurrentNodeID: PItemIDList;
  CurrentNodeExpanded: boolean;
  OldInhibit: boolean;
begin
  // If we don't have a window handle or are in the loading state, DON'T do
  // this stuff.  When the handle is created or the loading is finished, we
  // will call this again.
  if (not HandleAllocated) or (csLoading in ComponentState) then
    exit;

  // If we have a selection, stash the node ID so we can find it after
  // resetting. All of the node data is going to get cleared, so we have to
  // copy the selected ID, not just store the the current pointer.
  if (Selected <> NIL) and (Selected.Data <> NIL) and
     (TFolderItemData(Selected.Data).FQ_IDList <> NIL) then
  begin
    CurrentNodeID := CopyPIDL(TFolderItemData(Selected.Data).FQ_IDList);
    CurrentNodeExpanded := Selected.Expanded;
  end
  else
  begin
    CurrentNodeID := NIL;
    CurrentNodeExpanded := FALSE;
  end;
  OldInhibit := InhibitReadDelay;
  InhibitReadDelay := TRUE;
  Items.BeginUpdate;
  try
    // Clear old stuff
    Selected := NIL;
    FreeAllItemData;
    Items.Clear;

    if (FRootFolder = rfCustom) then
      Success := GetIDFromPath(FDesktopFolder, FCustomDir, RootID)
    else
      Success := SUCCEEDED(SHGetSpecialFolderLocation(GetValidHandle,
         GetFolderID, RootID));

    if Success then
    begin
      RootNode := AddNode(FDesktopFolder, ConcatPIDLs(NIL, RootID), RootID, NIL);
      if FExpandRoot and assigned(RootNode) and (Items.Count > 0) then
        RootNode.Expand(FALSE);
    end; //if

    if SortType <> stNone then
      AlphaSort;

    if FLastSelection <> '' then
    begin
      Selection := FLastSelection;
      FLastSelection := '';
    end
    else if CurrentNodeID <> 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(CurrentNodeID) // Move to the next ID in the list}
      else
        FindID := CurrentNodeID;

      Selected := FindNodeFromID(FindID);
      if Selected <> NIL then
      begin
        Selected.MakeVisible;
        if CurrentNodeExpanded and CanExpand(Selected) then
          Selected.Expand(FALSE);
      end;
    end;

  finally
    Items.EndUpdate;
    InhibitReadDelay := OldInhibit;
    FreePIDL(CurrentNodeID);
  end;

  inherited Reset;
end; {Reset}


(*******************************************************************************
  EnumerateFolders:
*******************************************************************************)
function TdfsSystemTreeView.EnumerateFolders(const ShellFolder: IShellFolder;
   const ParentNode: TTreeNode): boolean;
var
  Flags: DWORD;
  EnumList: IEnumIDList;
  FQ_List,
  List: PItemIDList;
  Fetched: ULONG;
  OldCursor: TCursor;
begin
  Result := FALSE;
  // Inhibit screen painting for speed
  Items.BeginUpdate;
  // I wish there was some way to find out the number of items being enumerated,
  // and only set the hourglass cursor if there were many of them....
  OldCursor := Cursor;
  Cursor := crHourglass;
  try
    Flags := SHCONTF_FOLDERS;
    if FShowHiddenDirs then
      Flags := Flags or SHCONTF_INCLUDEHIDDEN;
    if FShowFiles then
      Flags := Flags or SHCONTF_NONFOLDERS;
    if SUCCEEDED(ShellFolder.EnumObjects(GetValidHandle, Flags, EnumList)) then
    begin
      // Walk the folders. The list will be saved so don't free it anywhere.
      while EnumList.Next(1, List, Fetched) = S_OK do
      begin
        Result := TRUE;  // only successful if we enumerated at least once.
        if assigned(ParentNode) then
          with TFolderItemData(ParentNode.Data) do
            FQ_List := ConcatPIDLs(FQ_IDList, List)
        else
          FQ_List := ConcatPIDLs(NIL, List);

        if AddNode(ShellFolder, FQ_List, List, ParentNode) = NIL then
        begin
          // not added for some reason.  Free up resources.
          FreePIDL(FQ_List);
          FreePIDL(List);
        end;
      end; {while}
      {$IFNDEF DFS_NO_COM_CLEANUP} EnumList.Release; {$ENDIF}
    end else
      // Maybe an event for this???  No items to enum when there should be.
      ;
  finally
    // always protect this stuff to make sure it gets reset.
    Items.EndUpdate;
    Cursor := OldCursor;
  end;
end;


(*******************************************************************************
  AddNode:
*******************************************************************************)
function TdfsSystemTreeView.AddNode(const ShellFolder: IShellFolder;
   FQ_IDList, IDList: PItemIDList; const ParentNode: TTreeNode): TTreeNode;
var
  NiceName, FullName: string;
  Flags: DWORD;
  Attrs: UINT;
{$IFNDEF DFS_STV_FASTMODE}
  Normal,
  Selected: integer;
{$ENDIF}
  EnumList: IEnumIDList;
  List: PItemIDList;
  Fetched: ULONG;
  SubFolder: IShellFolder;
  NodeData: TFolderItemData;
  NoPIDL: PItemIDList;
begin
  Result := NIL;
  NoPIDL := NIL;
  Attrs := SFGAO_VALIDATE;
  // Invalidate cached information.
  ShellFolder.GetAttributesOf(0, NoPIDL, Attrs);
{ This fails for UNC names at root.....
  if GetNiceName(ShellFolder, IDList, SHGDN_NORMAL, NiceName) then begin}
  NiceName := GetDisplayName(ShellFolder, IDList, dntNormal);
  begin
    if (ParentNode = NIL) and (FRootFolder = rfCustom) and
       (FCustomDirCaption <> '') then
      NiceName := FCustomDirCaption;
    // SFGAO_CONTENTSMASK is incorrect in the SDK header (not Borland's fault).
    Attrs := SFGAO_CAPABILITYMASK or SFGAO_DISPLAYATTRMASK and
       (not SFGAO_READONLY) or SFGAO_REMOVABLE or $F0000000{SFGAO_CONTENTSMASK};
    ShellFolder.GetAttributesOf(1, IDList, Attrs);
    if (FRootFolder = rfFileSystem) and
       ((Attrs and (SFGAO_FILESYSTEM or SFGAO_FILESYSANCESTOR)) = 0) then exit;

    // mask!
    if (FFileMask <> '') and ((Attrs and SFGAO_FOLDER) = 0) then
    begin
      SetLength(FullName, MAX_PATH);
      if SHGetPathFromIDList(FQ_IDList, PChar(FullName)) then
      begin
        SetLength(FullName, StrLen(PChar(FullName)));
        if not MaskSearch.FileMatches(FullName, FFileMaskList) then
        begin
          Result := NIL;
{ Removed by LSP
          FreePIDL(IDList);
          FreePIDL(FQ_IDList);}
          exit;
        end;
      end;
    end;

    Result := Items.AddChildObject(ParentNode, NiceName,
       AddItemData(ShellFolder, IDList, FQ_IDList, Attrs));

{$IFNDEF DFS_STV_FASTMODE}
    GetNormalAndSelectedIcons(FQ_IDList, Normal, Selected);

    if (Selected = 0) and (Normal <> 0) then
      Selected := Normal;