systemtreeview.pas

动态提示控件

uses
  ShellAPI, MaskSearch, FileCtrl,
  {$IFDEF DFS_COMPILER_4_UP} ImgList, {$ENDIF}
  {$IFDEF DFS_COMPILER_3_UP} ComObj, {$ELSE} OleAuto, {$ENDIF}
  {$IFDEF DFS_DEBUG} EJHkEng, {$ENDIF}
  Registry;

var
  NewCount: Longint;


{$IFDEF DFS_COMPILER_2}
function SHGetDataFromIDList; external 'shell32.dll' name 'SHGetDataFromIDListA';
{$ENDIF}


function DefaultTreeViewSort(Node1, Node2: TTreeNode; lParam: Integer): Integer;
   stdcall;
begin
  // CompareIDs can probably handle NIL pointers.  need to try it.
  if Node1 = Node2 then
    Result := 0
  else if Node1 = NIL then
    Result := -1
  else if Node2 = NIL then
    Result := 1
  else begin
    if Node1.Data <> NIL then with TFolderItemData(Node1.Data) do
    begin
      // Status is returned in the 'code' portion (low word) of the result.
      // Search for 'HResult' in Winodws.pas to read more about it.
      // 0 means sort by name.
      Result := shortint(SFParent.CompareIDs(0,
         TFolderItemData(Node1.Data).IDList,
         TFolderItemData(Node2.Data).IDList));
    end else
      Result := 0;
  end;
end;


(*******************************************************************************
  Create:
*******************************************************************************)
constructor TdfsSystemTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // Set the defaults.
  OLECheck(SHGetDesktopFolder(FDesktopFolder));
  {$IFNDEF DFS_NO_COM_CLEANUP} FDesktopFolder.AddRef; {$ENDIF}
  FDestroyingSelf := FALSE;
  FCustomDir := '';
  FLastSelection := '';
  FAutoscroll := FALSE;
  FPopupMenuMethod := pmmContext;
  FCustomDirCaption := '';
  FShowFiles := FALSE;
  FShowErrorsInMsgBox := TRUE;
  FRootFolder := rfDesktop;
  FShowHiddenDirs := TRUE;
  FExpandRoot := TRUE;
  FCheckboxes := FALSE;
{$IFDEF DFS_STV_FILECHANGES}
  WatchedNode := NIL;
  FCThread := NIL;
  ParentThread := NIL;
  ParentWatchedNode := NIL;
{$ENDIF}
  ShowRoot := TRUE;
  SortType := stNone;
  FFileMask := '';
  FFileMaskList := TStringList.Create;
end; {Create}


(*******************************************************************************
  Destroy:
*******************************************************************************)
destructor TdfsSystemTreeView.Destroy;
begin
  FDestroyingSelf := TRUE;

  {$IFDEF DFS_COMPILER_5_UP}
  // This used to be in the TTreeNodes.Clear method, but in D5 it isn't done if
  // the component is being destroyed.  This prevents me from freeing the data
  // that has been put into each node's Data property.  I have no clue why this
  // was done, so we'll just call it ourself.
  // BTW, you don't want to know about FTreeHandle.  It's too bizarre...
  TreeView_DeleteAllItems(FTreeHandle);
  {$ENDIF}

  Selection := '';

{$IFDEF DFS_STV_FILECHANGES}
  if ParentThread <> NIL then
    ParentThread.Terminate;
  if FCThread <> NIL then
    FCThread.Terminate;
{$ENDIF}

  FFileMaskList.Free;

  // Free the image list object.  Doesn't release the image list handle because
  // it doesn't belong to us, but the system.  Go ahead, delete the handle and
  // see what happens.  :)   It won't crash anything, but Explorer will look a
  // bit strange until you reboot.
  Images.Free;

  inherited Destroy;

  {$IFNDEF DFS_NO_COM_CLEANUP} FDesktopFolder.Release; {$ENDIF}
//  FDesktopFolder := NIL;
end; {Destroy}


procedure TdfsSystemTreeView.CreateParams(var Params: TCreateParams);
const
  CheckboxesStyles: array[Boolean] of DWORD = (0, TVS_CHECKBOXES);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or CheckboxesStyles[FCheckboxes];
end;

procedure TdfsSystemTreeView.CreateWnd;
begin
  FRecreatingWnd := FALSE;
  inherited CreateWnd;
  FTreeHandle := Handle;
  // If we are loading object from stream (form file), we have to wait until
  // everything is loaded before populating the list.  If we are not loading,
  // i.e. the component was created dynamically or was just dropped on a form,
  // we need to populate it now since the Loaded method will never get called.
  if FCheckboxes then RestoreChecks;

  if not (csLoading in ComponentState) then
    Reset;
end;

procedure TdfsSystemTreeView.DestroyWnd;
begin
  // The window is only being recreated.  See CNNotify method.
  FRecreatingWnd := TRUE;
  if FLastSelection = '' then
    FLastSelection := Selection;
  if FCheckboxes then SaveChecks;

  inherited DestroyWnd;
end;

procedure TdfsSystemTreeView.Loaded;
begin
  inherited Loaded;
  Reset; // We've finished loading, we can populate the tree now.
end;

function TdfsSystemTreeView.GetSelection: string;
var
  SelNode: TTreeNode;
begin
  if HandleAllocated then begin
    SelNode := Selected;
    if SelNode = NIL then
      Result := ''
    else
      Result := GetNodePath(SelNode);
  end else
    Result := '';
end;

// Searches the tree for a fully qualified PIDL, expanding as it finds nodes
// that match.
function TdfsSystemTreeView.FindNodeFromID(AnID: PItemIDList): TTreeNode;
var
  SearchID,
  SimpleID,
  BakID,
  FQ_List: PItemIDList;
//  List: PItemIDList;
  Count: integer;
  Node: TTreeNode;
  ShellFolder: IShellFolder;
begin
  if (Items.Count < 1) or (AnID = NIL) then
  begin
    Result := NIL;
    exit;
  end;

  if AnID.mkid.cb = 0 then // nothing to search for.
  begin
    Result := Items[0];
    exit;
  end;

  // Initialize some stuff
  Count := 0;
  Node := Items[0];
  if Node.Count < 1 then
  begin
    // No sub-nodes to search, this is as deep as it gets.
    Result := Node;
    exit;
  end;

  with GetNodeData(Node.Item[Count]) do // Get the first item's data.
  begin
    SearchID := IDList; // It's relative ID
    ShellFolder := SFParent; // It's parent shell folder
  end;
  SimpleID := CopyFirstID(AnID); // Get the relative portion of the fully
                                    // qualified ID we're looking for.

  BakID := CopyFirstID(AnID); // Added by LSP
  try
    while assigned(SearchID) and assigned(SimpleID) do
    begin
      // Is the current portion of the ID we're looking for this node's child?
      if ShellFolder.CompareIDs(0, SearchID, SimpleID) = 0 then
      begin
        // Found a match for part of the ID we're looking for.
        Node := Node.Item[Count]; // Set current node to node that just matched.
        AnID := NextPIDL(AnID); // Move to the next ID in the list
        if AnID.mkid.cb = 0 then break; // Nothing else to find, we're done.
        FreePIDL(SimpleID); // Free copy of relative ID we made
        SimpleID := CopyFirstID(AnID); // Create copy of next relative part.
        // Added by LSP
        FQ_List := ConcatPIDLs(BakID, SimpleID);
        FreePIDL(BakID);
        BakID := FQ_List;
        // End LSP
        Node.Expand(FALSE); // Expand the matched node.
        Count := 0; // Reset search index.
        if Node.Count < 1 then break; // If the new node doesn't have children,
                                      // we can't go any farther.
      end else begin
        // Didn't match with the current child of the node.
        Inc(Count); // Increment the child node index
        // Added by LSP
        if Count >= Node.Count then break; // No more, didn't find it, get out. }
(* This code was causing all manner of bugs, so I've given up on it for the moment
        if Count >= Node.Count then
        begin // LSP Fix
          FQ_List := CopyPIDL(BakID);
          List := CopyPIDL(SimpleID);
          if AddNode(ShellFolder, FQ_List, List, Node) = NIL then
          begin
            // not added for some reason.  Free up resources.
            FreePIDL(FQ_List);
            FreePIDL(List);
          end;
          inc(Count);
        end;
        // End LSP
*)
      end; // if

      // Get the next child node's data
      if Count >= Node.Count then
        SearchID := NIL
      else
        with GetNodeData(Node.Item[Count]) do
        begin
          SearchID := IDList; // it's relative ID
          ShellFolder := SFParent; // it's shell folder
        end;
    end; // while

    Result := Node; // Return the deepest match we found.
  finally
    FreePIDL(SimpleID); // Free up relative ID copy we createed
    FreePIDL(BakID);    // Added by LSP: Free copy of backup ID we made
  end;
end; // FindNodeFromID


// This will work ONLY with files or directories.  Currenly there is no way of
// passing stuff like the Control Panel node.
procedure TdfsSystemTreeView.SetSelection(const ASel: string);
  function RelativeTo(Base, Full: string): string;
  begin
    if (Base <> '') and (Base[Length(Base)] <> '\') then
      Base := Base + '\';
    if StrLIComp(PChar(Base), PChar(Full), Length(Base)) = 0 then
      Result := Copy(Full, Length(Base)+1, Length(Full))
    else
      Result := Full;
  end;
var
  ShellFolder: IShellFolder;
  CustomID: PItemIDList;
  ChangeTo: string;
begin
  if ASel = '' then exit;
  if (([csLoading, csReading] * ComponentState) <> []) or
     (not HandleAllocated){ or (not Enabled)} then
    FLastSelection := ASel
  else if (Items.Count > 0) then  // Anything to search?
  begin
    if not Items[0].Expanded then
      Items[0].Expand(FALSE);
    ShellFolder := GetNodeData(Items[0].Item[0]).SFParent;
    if (RootFolder in [rfDesktop, rfDrives, rfFileSystem]) then
      ChangeTo := ASel
    else
      ChangeTo := RelativeTo(Items[0].Text, ASel);
    if GetIDFromPath(ShellFolder, ChangeTo, CustomID) then
    begin
      Items.BeginUpdate;
      try
        // Find CustomID's tree node and select it.
        Selected := FindNodeFromID(CustomID);
        if Selected <> NIL then
          Selected.MakeVisible;
      finally
        Items.EndUpdate;
        FreePIDL(CustomID);
      end; //try
    end;
  end;
end;

function TdfsSystemTreeView.GetItemCheck(Node: TTreeNode): boolean;
var
  Item: TTVItem;
begin
  Result := FALSE;
  if Node <> NIL then
  begin
  { Can't use this because the stupid VCL doesn't update the property when
    the user clicks on it, only when you change it in code.  Got to do it the
    old fashioned way...
    Result := Node.StateIndex = 2;}
    
    FillChar(Item, SizeOf(Item), #0);
    Item.mask := TVIF_STATE;
    Item.hItem := Node.ItemId;
    Item.stateMask := TVIS_STATEIMAGEMASK;
    TreeView_GetItem(Handle, Item);
    Result := (Item.State and IndexToStateImageMask(2)) <> 0;
  end;
end;

procedure TdfsSystemTreeView.SetItemCheck(Node: TTreeNode; Val: boolean);
const
  CHECKINT: array[boolean] of integer = (1, 2);
begin
  if Node <> NIL then
  begin
    Node.StateIndex := CHECKINT[Val];
  end;
end;



(*******************************************************************************
  CNNotify:  Trap notification messages sent to the window.
    This is damn silly, but it's the only way we can know when a node is being
    deleted. I think it's an oversight in the VCL, so until Borland fixes it,
    just live with it.
*******************************************************************************)
procedure TdfsSystemTreeView.CNNotify(var Message: TWMNotify);
var
  Node: TTreeNode;
{$IFDEF DFS_STV_FASTMODE}
  N, S: integer;
  CallInh: boolean;
{$ENDIF}
begin
  // We have to ignore the delete notification if the window is being recreated,
  // that is someone did something like change our BorderStyle, because the
  // items are deleted, but saved to a memory stream and then restored including
  // the pointers.
  if (not FRecreatingWnd) and (Message.NMHdr.code = TVN_DELETEITEM) then
  begin
    // If deleting an item, grab the TFolderItemData associated with it so we
    // can free that up
{$IFDEF DFS_DEBUG} LogUserMessage(Format('PNMTreeView: %p', [Message.NMHdr])); {$ENDIF}
{$IFDEF DFS_DEBUG} if Message.NMHdr <> NIL then LogUserMessage(Format('GetNodeFromItem %p', [PNMTreeView(Pointer(Message.NMHdr))^.itemOld.hItem])); {$ENDIF}
    with PNMTreeView(Pointer(Message.NMHdr))^ do
      Node := GetNodeFromItem(itemOld);
    if Node <> NIL then
      FreeItemData(Node);
  end;

{$IFDEF DFS_STV_FASTMODE}
  CallInh := TRUE;

  if Message.NMHdr.code = TVN_GETDISPINFO then
  begin
    with PTVDispInfo(Pointer(Message.NMHdr))^.item do
    begin
      if (mask and TVIF_PARAM) <> 0 then
        Node := TTreeNode(lParam)
      else
        Node := Items.GetNode(hItem);

      if (Node <> NIL) and (Node.Data <> NIL) then
      begin
        with TFolderItemData(Node.Data) do
        begin
          if (mask and (TVIF_IMAGE or TVIF_SELECTEDIMAGE)) <> 0 then
          begin