systemtreeview.pas

动态提示控件

    if (Attrs and SFGAO_FOLDER) = 0 then
    begin
      Result.ImageIndex := Selected;
      Result.SelectedIndex := Selected;
    end else begin
      Result.ImageIndex := Normal;
      Result.SelectedIndex := Selected;
    end;
{$ENDIF}

    // added by Peter Ruskin 26/09/97 to get the share and link icons
    // Modified just a bit by Brad Stowers.
    if (SFGAO_SHARE and Attrs) <> 0 then { $20000 if shared }
    begin
      Result.OverlayIndex := 0;        { you can have four of these (0..3) }
// Causes incorrect overlay on some machines.  Shouldn't be necessary.
//      Images.Overlay(28, 0);   { 28 is index of share "hand" in Shell32.dll }
    end;   // share icons

    if (SFGAO_LINK and Attrs) <> 0 then { $00010000 if shared }
    begin
      Result.OverlayIndex := 1;        { you can have four of these (0..3) }
// Causes incorrect overlay on some machines.  Shouldn't be necessary.
//      Images.Overlay(29, 1);   { 29 is index of link "arrow" in Shell32.dll }
    end;   // link (Shortcut) icons
    // end changes by Peter Ruskin

    Result.HasChildren := (Result.Data <> NIL) and
       (TFolderItemData(Result.Data).ItemHasFlag(SFGAO_HASSUBFOLDER));
    if FShowFiles and (not Result.HasChildren) then
    begin
      // see if enum can find anything
      NodeData := TFolderItemData(Result.Data);
      if (ShellFolder.BindToObject(NodeData.IDList, NIL, IID_IShellFolder,
         pointer(SubFolder))) = S_OK then
      begin
        Flags := SHCONTF_NONFOLDERS;
        if ShowHiddenDirs then
          Flags := Flags or SHCONTF_INCLUDEHIDDEN;
        if SUCCEEDED(SubFolder.EnumObjects(GetValidHandle, Flags,
           EnumList)) then
        begin
          Result.HasChildren := TRUE;
          if EnumList.Next(1, List, Fetched) = S_OK then
            Result.HasChildren := Fetched > 0;
          FreePIDL(List);
          {$IFNDEF DFS_NO_COM_CLEANUP} EnumList.Release; {$ENDIF}
        end;
        {$IFNDEF DFS_NO_COM_CLEANUP} SubFolder.Release; {$ENDIF}
      end;
    end;
  end; {if}
end; {AddNode}


(*******************************************************************************
  AddItemData:
*******************************************************************************)
function TdfsSystemTreeView.AddItemData(ItemFolder: IShellFolder;
   aIDList, aFQ_IDList: PItemIDList; Attrs: UINT): TFolderItemData;
begin
  Result := TFolderItemData.Create;
  with Result do
  begin
    Initialized := FALSE;
    SFParent := ItemFolder;
    {$IFNDEF DFS_NO_COM_CLEANUP} SFParent.AddRef; {$ENDIF}
    IDList := aIDList;
    FQ_IDList := aFQ_IDList;
    Attributes := Attrs;
    FileSizeHigh := 0;
    FileSizeLow := 0;
  end;
  inc(NewCount);
end; {AddItemDta}


(*******************************************************************************
  FreeItemData:
*******************************************************************************)
procedure TdfsSystemTreeView.FreeItemData(Item: TTreeNode);
begin
  if Item.Data <> NIL then
  begin
    with GetNodeData(Item) do
    begin
      FreePIDL(FIDList);
      FreePIDL(FFQ_IDList);
      {$IFNDEF DFS_NO_COM_CLEANUP}
      if SFParent <> NIL then
        SFParent.Release;
      {$ENDIF}
    end;
    TFolderItemData(Item.Data).Free;
    // For some reason, setting Data to NIL is blowing up in D5. Bizarre.
    if not (csDestroying in ComponentState) then
      Item.Data := NIL;
    dec(NewCount);
  end;
end; {FreeItemData}


(*******************************************************************************
  FreeAllItemData:
*******************************************************************************)
procedure TdfsSystemTreeView.FreeAllItemData;
var
  x: integer;
begin
  for x := 0 to Items.Count-1 do
    FreeItemData(Items[x]);
(* This is old stuff that isn't needed any more.  list doesn't share pointers
   starting with v0.96
{$IFDEF DFS_SCP_SYSLISTVIEW}
  // Make sure list view doesn't keep an invalid node pointer.
  if (FListView <> NIL) then
    ListView.FLastNode := NIL;
{$ENDIF}
*)
end; {FreeAllItemData}


(*******************************************************************************
  SetRootFolder:
*******************************************************************************)
procedure TdfsSystemTreeView.SetRootFolder(Val: TRootFolder);
begin
  if Val = FRootFolder then exit;
  FRootFolder := Val;
  Reset;
end; {SetRootFolder}


(*******************************************************************************
  DisplayContextMenu:
*******************************************************************************)
function TdfsSystemTreeView.DisplayContextMenu(Node: TTreeNode;
   Where: TPoint): boolean;
var
  ItemData: TFolderItemData;
  WantsToRename: boolean;
begin
  ItemData := GetNodeData(Node);
  if (ItemData <> NIL) and (ItemData.IDList <> NIL) then
  begin
{$IFDEF DFS_COMPILER_4_UP}
    Result := ItemProp.DisplayContextMenu(ItemData.SFParent,
       ItemData.FIDList, ItemData.Attributes, DFS_HWND(Handle), Where, 1, TRUE,
       WantsToRename);
{$ELSE}
    Result := ItemProp.DisplayContextMenuPIDL(ItemData.SFParent,
       ItemData.FIDList, ItemData.Attributes,
       {$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, Where, 1,
       TRUE, WantsToRename);
{$ENDIF}
    if WantsToRename then
      Node.EditText;
  end
  else
    Result := FALSE;
end;

function TdfsSystemTreeView.GetItemData(Index: integer): TFolderItemData;
begin
  Result := GetNodeData(Items[Index]);
end;

function TdfsSystemTreeView.GetNodeData(Node: TTreeNode): TFolderItemData;
begin
  Result := NIL;
  if Node <> NIL then
  begin
    Result := Node.Data;
    if Result = NIL then
    begin
      if FShowErrorsInMsgBox then
        MessageDlg(LoadStr(IDS_NOFOLDERDATA), mtError, [mbOK], 0)
      else
        raise ENoFolderData.Create(LoadStr(IDS_NOFOLDERDATA));
    end;
  end;
end;

procedure TdfsSystemTreeView.Expand(Node: TTreeNode);
{$IFDEF DFS_DEBUG}
var
  TC: DWORD;
{$ENDIF}
begin
{$IFDEF DFS_DEBUG} TC := timeGetTime; {$ENDIF}
  Items.BeginUpdate;
  try
    Node.CustomSort(@DefaultTreeViewSort, 0);
  finally
    Items.EndUpdate;
  end;

  inherited Expand(Node);
end;

function TdfsSystemTreeView.CustomSort(SortProc: TTVCompare;
   Data: Longint): Boolean;
var
  SortCB: TTVSortCB;
  Node: TTreeNode;
begin
  Result := False;
  if not HandleAllocated then exit;
  with SortCB do
  begin
    if not Assigned(SortProc) then
      lpfnCompare := @DefaultTreeViewSort
    else
      lpfnCompare := SortProc;
    hParent := TVI_ROOT;
    lParam := Data;
    Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
  end; // with

  if (Items.Count > 0) then
  begin
    Node := Items.GetFirstNode;
    while (Node <> nil) do
    begin
      if Node.HasChildren then
        Node.CustomSort(@DefaultTreeViewSort, Data);
      Node := Node.GetNext;
    end; // while
  end; // if
end; // CustomSort


function TdfsSystemTreeView.AlphaSort: Boolean;
begin
  if HandleAllocated then
  begin
    Items.BeginUpdate;
    try
      Result := CustomSort(@DefaultTreeViewSort, 0);
    finally
      Items.EndUpdate;
    end;
  end else
    Result := False;
end;


procedure TdfsSystemTreeView.DblClick;
begin
  inherited DblClick;
end;

function TdfsSystemTreeView.GetPopupMenu: TPopupMenu;
begin
  if FPopupMenuMethod in [pmmUser, pmmContextUser] then
    Result := inherited GetPopupMenu
  else
    Result := NIL;
end;

{$IFDEF DFS_COMPILER_5_UP}
procedure TdfsSystemTreeView.WMContextMenu(var Message: TWMContextMenu);
{$ELSE}
procedure TdfsSystemTreeView.WMRButtonUp(var Message: TWMRButtonUp);
{$ENDIF}
var
  SelNode: TTreeNode;
  Pt: TPoint;
begin
  case FPopupMenuMethod of
    pmmContext,
    pmmContextUser:
      begin
        {$IFDEF DFS_COMPILER_5_UP}
        Pt := ScreenToClient(Point(Message.XPos, Message.YPos));
        {$ELSE}
        Pt := Point(Message.XPos, Message.YPos);
        {$ENDIF}
        SelNode := GetNodeAt(Pt.x, Pt.y);
        if SelNode <> NIL then
        begin
          Selected := SelNode;
          if DisplayContextMenu(SelNode, ClientToScreen(Pt)) then
            Message.Result := 1;
        end;
      end;
  end;
  inherited;
end;


procedure TdfsSystemTreeView.ResetNode(const Node: TTreeNode);
var
  RedoExpand: boolean;
begin
  if Node = NIL then exit;
  RedoExpand := Node.Expanded;
  Node.DeleteChildren;
  if Node.Data <> NIL then
  begin
    GetNodeData(Node).Initialized := FALSE;
    if CanExpand(Node) and RedoExpand then
      Node.Expand(FALSE);
//!!! Old v0.95 code.  Notification below should be enough for new version.
(*
{$IFDEF DFS_SCP_SYSLISTVIEW}
    if (FListView <> NIL) then
      FListView.ResetNode(Node, (RootFolder = rfDesktop) and
         (Selected.AbsoluteIndex = 0));
{$ENDIF}
{$IFDEF DFS_SCP_SYSCOMBOBOX}
    if (FComboBox <> NIL) then
      FComboBox.ActiveFolderIDList :=
         CopyPIDL(TFolderItemData(Node.Data).FQ_IDList);
{$ENDIF}
*)
  end;
  NotifyLinkedControls(TRUE);
end;


(*******************************************************************************
  CanEdit - 29/8/96 (By Thomas AW Brown)
*******************************************************************************)
function TdfsSystemTreeView.CanEdit(Node: TTreeNode): boolean;
begin
  Result := (Node.Data <> NIL) and NodeData[Node].ItemHasFlag(SFGAO_CANRENAME);
end;

(*******************************************************************************
  Edit - 29/8/96 (By Thomas AW Brown)
       - 11/9/96 Moved guts of it to RenameNode so it could be used
                 programatically. (bds)
*******************************************************************************)
procedure TdfsSystemTreeView.Edit(const Item: TTVItem);
begin
  if RenameNode(GetNodeFromItem(Item), Item.pszText) then
    inherited Edit(Item);
end;

{$IFDEF DFS_STV_FILECHANGES}
procedure TdfsSystemTreeView.WatchDirectoryForChanges(const ANode: TTreeNode);
var
  APath: string;
  WatchedAttrs: TFSFilterSet;
begin
  if ParentThread <> NIL then
  begin
    ParentThread.Terminate;
    ParentThread := NIL;
    ParentWatchedNode := NIL;
  end;
  if FCThread <> NIL then
  begin
    FCThread.Terminate;  // it will destroy itself.
    FCThread := NIL;
    WatchedNode := NIL;
  end;
  APath := GetNodePath(ANode);
  if ShowFiles and FileExists(APath) then
    APath := ExtractFilePath(APath);
  if (APath <> '') then
  begin
    WatchedNode := ANode;
{$IFDEF DFS_SCP_SYSLISTVIEW}
    if (ListView <> NIL) or ShowFiles then
      WatchedAttrs := [fsfFilename, fsfDirname, fsfAttributes, fsfSize,
         fsfLastWrite]
    else
{$ELSE}
    if ShowFiles then
{$ENDIF}
      WatchedAttrs := [fsfDirname];
    FCThread := TFileChangeThread.Create(APath, WatchedAttrs, FALSE);
    FCThread.OnTerminate := ThreadDone;

  { Have to watch the parent node as well in case the one we are in does
    something -- like get deleted }
    ParentWatchedNode := WatchedNode.Parent;
    if ParentWatchedNode <> NIL then
    begin
      APath := GetNodePath(ParentWatchedNode);
      if (APath <> '') then
      begin
        ParentThread := TFileChangeThread.Create(APath, [fsfDirname], FALSE);
        ParentThread.OnTerminate := ParentThreadDone;
      end;
    end;
  end;
end;

procedure TdfsSystemTreeView.ThreadDone(Sender: TObject);
var
  Temp: TTreeNode;
  TExpanded : Boolean;
  dir: string;
begin
  FCThread := NIL;
  // Don't need to watch the parent any more.
  if ParentThread <> NIL then
  begin
    ParentWatchedNode := NIL;
    ParentThread.Terminate;