home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / SystemTreeView.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-28  |  67KB  |  2,072 lines
  1. {$I DFS.INC}                    { Defines for all Delphi Free Stuff components }
  2. {$I SYSTEMCONTROLPACK.INC}      { Defines specific to these components }
  3.  
  4. { -----------------------------------------------------------------------------}
  5. { TdfsSystemTreeView                                                           }
  6. { -----------------------------------------------------------------------------}
  7. { A tree view control that acts as the tree in the Windows Explorer.  This is  }
  8. { part of the System Control Pack.                                             }
  9. {                                                                              }
  10. { Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
  11. {                                                                              }
  12. { Copyright:                                                                   }
  13. { All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
  14. { Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
  15. { property of the author.                                                      }
  16. {                                                                              }
  17. { Distribution Rights:                                                         }
  18. { You are granted a non-exlusive, royalty-free right to produce and distribute }
  19. { compiled binary files (executables, DLLs, etc.) that are built with any of   }
  20. { the DFS source code unless specifically stated otherwise.                    }
  21. { You are further granted permission to redistribute any of the DFS source     }
  22. { code in source code form, provided that the original archive as found on the }
  23. { DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
  24. { example, if you create a descendant of TDFSColorButton, you must include in  }
  25. { the distribution package the colorbtn.zip file in the exact form that you    }
  26. { downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
  27. {                                                                              }
  28. { Restrictions:                                                                }
  29. { Without the express written consent of the author, you may not:              }
  30. {   * Distribute modified versions of any DFS source code by itself. You must  }
  31. {     include the original archive as you found it at the DFS site.            }
  32. {   * Sell or lease any portion of DFS source code. You are, of course, free   }
  33. {     to sell any of your own original code that works with, enhances, etc.    }
  34. {     DFS source code.                                                         }
  35. {   * Distribute DFS source code for profit.                                   }
  36. {                                                                              }
  37. { Warranty:                                                                    }
  38. { There is absolutely no warranty of any kind whatsoever with any of the DFS   }
  39. { source code (hereafter "software"). The software is provided to you "AS-IS", }
  40. { and all risks and losses associated with it's use are assumed by you. In no  }
  41. { event shall the author of the softare, Bradley D. Stowers, be held           }
  42. { accountable for any damages or losses that may occur from use or misuse of   }
  43. { the software.                                                                }
  44. {                                                                              }
  45. { Support:                                                                     }
  46. { Support is provided via the DFS Support Forum, which is a web-based message  }
  47. { system.  You can find it at http://www.delphifreestuff.com/discus/           }
  48. { All DFS source code is provided free of charge. As such, I can not guarantee }
  49. { any support whatsoever. While I do try to answer all questions that I        }
  50. { receive, and address all problems that are reported to me, you must          }
  51. { understand that I simply can not guarantee that this will always be so.      }
  52. {                                                                              }
  53. { Clarifications:                                                              }
  54. { If you need any further information, please feel free to contact me directly.}
  55. { This agreement can be found online at my site in the "Miscellaneous" section.}
  56. {------------------------------------------------------------------------------}
  57. { The lateset version of my components are always available on the web at:     }
  58. {   http://www.delphifreestuff.com/                                            }
  59. { See SCP.txt for notes, known issues, and revision history.                   }
  60. { -----------------------------------------------------------------------------}
  61. { Date last modified:  June 28, 2001                                           }
  62. { -----------------------------------------------------------------------------}
  63.  
  64. unit SystemTreeView;
  65.  
  66. interface
  67.  
  68. {$IFNDEF DFS_SCP_SYSTREEVIEW}
  69.   Error, should not be compiing this unit!
  70. {$ENDIF}
  71.  
  72.  
  73. {$R ErrorMsgs.r32}
  74.  
  75. uses
  76.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  77.   {$IFDEF DFS_COMPILER_3_UP} ShlObj, ActiveX, {$ELSE} MyShlObj, OLE2, {$ENDIF}
  78.   {$IFDEF DFS_STV_FILECHANGES} FileChange, {$ENDIF}
  79.   {$IFDEF DFS_DEBUG} MMSystem, {$ENDIF}
  80.   SystemControlPack,
  81.   PidlHelp, ItemProp, Menus, ComCtrls, StdCtrls, CommCtrl, _Res__IDs;
  82.  
  83. const
  84.   DFS_COMPONENT_TREE_VERSION = 'TdfsSystemTreeView ' + DFS_SCP_VERSION;
  85.  
  86. {$IFDEF DFS_DELPHI}
  87. {$IFNDEF DFS_DELPHI_4_UP}
  88. const
  89.   TVS_CHECKBOXES          = $0100;
  90. {$ENDIF}
  91. {$ELSE}
  92. {$IFDEF DFS_CPPB_1}
  93. const
  94.   TVS_CHECKBOXES          = $0100;
  95. {$ENDIF}
  96. {$ENDIF}
  97.  
  98. type
  99.   // If you change the order of these, you have to change the order of the
  100.   // FOLDERID constants below in GetFolderID function.
  101.   TRootFolder = (rfDesktop, rfRecycleBin, rfControlPanel, rfDesktopDir,
  102.      rfDrives, rfFavoriteURLs, rfFonts, rfNetHood, rfNetHoodDir, rfDocumentDir,
  103.      rfPrinters, rfPrograms, rfRecentDir, rfSendTo, rfStartMenu, rfStartup,
  104.      rfTemplates, rfFileSystem, rfCustom);
  105.  
  106.  
  107.   TdfsSystemTreeView = class(TdfsCustomSystemTreeView)
  108.   private
  109.     FDesktopFolder: IShellFolder;
  110.     FLastSelection: string;
  111.     FRecreatingWnd: boolean;
  112.     FShowErrorsInMsgBox: boolean;
  113.     FAutoscroll: boolean;
  114.     FRootFolder: TRootFolder;
  115.     FShowHiddenDirs: boolean;
  116.     FExpandRoot: boolean;
  117.     FCheckboxes: boolean;
  118.     FCustomDir: string;
  119.     FCustomDirCaption: string;
  120.     FShowFiles: boolean;
  121.     FPopupMenuMethod: TPopupMenuMethod;
  122.     FTreeHandle: HWND;
  123.     {$IFDEF DFS_STV_FILECHANGES}
  124.     ParentThread: TFileChangeThread;
  125.     ParentWatchedNode: TTreeNode;
  126.     FCThread: TFileChangeThread;
  127.     WatchedNode: TTreeNode;
  128.     {$ENDIF}
  129.     FFileMask: string;
  130.     FFileMaskList: TStringList;
  131.     FOnPopulated: TTVExpandedEvent;
  132.     FDestroyingSelf: boolean;
  133.  
  134.     procedure RestoreChecks;
  135.     procedure SaveChecks;
  136.     function GetIDFromPath(const ShellFolder: IShellFolder; const APath: string;
  137.        var ID: PItemIDList): boolean;
  138.     function GetFolderID: integer;
  139.     function EnumerateFolders(const ShellFolder: IShellFolder;
  140.        const ParentNode: TTreeNode): boolean;
  141.     function AddItemData(ItemFolder: IShellFolder; aIDList,
  142.        aFQ_IDList: PItemIDList; Attrs: UINT): TFolderItemData;
  143.     procedure FreeItemData(Item: TTreeNode);
  144.     procedure FreeAllItemData;
  145.     function GetSelection: string;
  146.     procedure SetSelection(const ASel: string);
  147.     function GetItemCheck(Node: TTreeNode): boolean;
  148.     procedure SetItemCheck(Node: TTreeNode; Val: boolean);
  149.     {$IFDEF DFS_COMPILER_5_UP}
  150.     procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  151.     {$ELSE}
  152.     procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  153.     {$ENDIF}
  154.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  155.   protected
  156.     procedure TimerEvent; override;
  157.     { Base Class Abstract Implementations }
  158.     // Implementation must return the actual ID list.  Caller will make a copy
  159.     // of it it wants it's own.  Implementer owns this one, i.e. it's the "real
  160.     // thing".  If there isn't one, return NIL.
  161.     function GetSelectionPIDL: PItemIDList; override;
  162.     function GetSelectionParentFolder: IShellFolder; override;
  163.     // Implementation notes: IDList parameter belongs to someone else.  If
  164.     // needed by this component, a copy must be made of it.  This differs from
  165.     // the Reset method in that it does not notify linked controls of a change
  166.     // because that could result in an endless cycle of notifications. Return
  167.     // value indicates success or failure.
  168.     function LinkedReset(const ParentFolder: IShellFolder;
  169.        const IDList: PItemIDList; ForceUpdate: boolean): boolean; override;
  170.  
  171.     procedure CreateParams(var Params: TCreateParams); override;
  172.     procedure CreateWnd; override;
  173.     procedure DestroyWnd; override;
  174.     procedure Loaded; override;
  175.     function CanExpand(Node: TTreeNode): boolean; override;
  176.     function CanEdit(Node: TTreeNode): boolean; override;
  177.     procedure Edit(const Item: TTVItem); override;
  178.     procedure Change(Node: TTreeNode); override;
  179.     procedure DoStartDrag(var DragObject: TDragObject); override;
  180.     function GetPopupMenu: TPopupMenu; override;
  181.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  182.     procedure Compute_TreeMoves(X, Y: integer); dynamic;
  183.     procedure Populated(Node: TTreeNode); dynamic;
  184.  
  185.     // Helpers
  186.       // Why isn't there one of these in TTreeView????
  187.     procedure DeleteItem(Node: TTreeNode); dynamic;
  188.     function GetNodeFromItem(const Item: TTVItem): TTreeNode;
  189.     function FindNodeFromID(AnID: PItemIDList): TTreeNode;
  190.  
  191.     // event for this?
  192.     function AddNode(const ShellFolder: IShellFolder;
  193.        FQ_IDList, IDList: PItemIDList; const ParentNode: TTreeNode): TTreeNode;
  194.        dynamic;
  195.  
  196.     // Property methods.
  197.     procedure SetRootFolder(Val: TRootFolder);
  198.     procedure SetCustomDir(const Val: string);
  199.     procedure SetCustomDirCaption(const Val: string);
  200.     procedure SetShowFiles(Val: boolean);
  201.     function GetVersion: string;
  202.     procedure SetVersion(const Val: string);
  203.     function GetItems: TTreeNodes;
  204.     procedure SetCheckboxes(Val: boolean);
  205.     procedure SetFileMask(const Val: string);
  206.  
  207.     // These two do the same thing, just take different parameters.
  208.     function GetItemData(Index: integer): TFolderItemData;
  209.     function GetNodeData(Node: TTreeNode): TFolderItemData;
  210.     procedure Expand(Node: TTreeNode); override;
  211.     function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean; dynamic;
  212.     function AlphaSort: Boolean;
  213.     procedure DblClick; override;
  214.   public
  215.     constructor Create(AOwner: TComponent); override;
  216.     destructor Destroy; override;
  217.     procedure Reset; override;
  218.     function DisplayContextMenu(Node: TTreeNode; Where: TPoint): boolean;
  219.        dynamic;
  220.     procedure ResetNode(const Node: TTreeNode);
  221.     function GetNodePath(const Node: TTreeNode): string;
  222.     {$IFDEF DFS_SCP_SYSCOMBOBOX}
  223.     procedure ComboBoxSetSelectionPIDL(APIDL: PItemIDList);
  224.     {$ENDIF}
  225.  
  226.     // Useful functions for applications.  These modify permanently, not just
  227.     // the node.  i.e. if you rename 'My Computer' to 'Crasher', it is renamed
  228.     // system wide, not just in your app.  If you delete the 'C:\WINDOWS'
  229.     // folder, you are in deep trouble and I deny any responsibility.
  230.     function RenameNode(const Node: TTreeNode; const NewName: string): boolean;
  231.     function DeleteNode(const Node: TTreeNode): boolean;
  232.     function AddNewNode(const ParentNode: TTreeNode; const NodeName: string;
  233.        SelectNewNode: boolean): boolean;
  234.     // Move up one directory, i.e. "cd .."
  235.     procedure ChangeToParent;
  236.  
  237.     {$IFDEF DFS_STV_FILECHANGES}
  238.     procedure WatchDirectoryForChanges(const ANode: TTreeNode);
  239.     procedure ParentThreadDone(Sender: TObject);
  240.     procedure ThreadDone(Sender: TObject);
  241.     {$ENDIF}
  242.     property ShowErrorsInMsgBox: boolean
  243.        read FShowErrorsInMsgBox write FShowErrorsInMsgBox default TRUE;
  244.     property Items
  245.        read GetItems;
  246.     property ItemChecked[Node: TTreeNode]: boolean
  247.        read GetItemCheck write SetItemCheck;
  248.     property NodeData[Node: TTreeNode]: TFolderItemData
  249.        read GetNodeData;
  250.   published
  251.     {$IFDEF DFS_SCP_SYSLISTVIEW}
  252.     property ListView;
  253.     {$ENDIF}
  254.     {$IFDEF DFS_SCP_SYSCOMBOBOX}
  255.     property ComboBox;
  256.     {$ENDIF}
  257.     property ReadDelay;
  258.  
  259.  
  260.     property Version: string
  261.        read GetVersion
  262.        write SetVersion
  263.        stored FALSE;
  264.     property PopupMenuMethod: TPopupMenuMethod
  265.        read FPopupMenuMethod
  266.        write FPopupMenuMethod
  267.        default pmmContext;
  268.     property Selection: string
  269.        read GetSelection write SetSelection;
  270.     property Directory: string
  271.        read GetSelection write SetSelection stored FALSE;
  272.     property RootFolder: TRootFolder
  273.        read FRootFolder write SetRootFolder default rfDesktop;
  274.     property CustomDir: string
  275.        read FCustomDir write SetCustomDir;
  276.     property CustomDirCaption: string
  277.        read FCustomDirCaption write SetCustomDirCaption;
  278.     property ShowFiles: boolean
  279.        read FShowFiles write SetShowFiles default FALSE;
  280.     property ShowHiddenDirs: boolean
  281.        read FShowHiddenDirs write FShowHiddenDirs default TRUE;
  282.     property ExpandRoot: boolean
  283.        read FExpandRoot write FExpandRoot default TRUE;
  284.     property Checkboxes: boolean
  285.        read FCheckboxes write SetCheckboxes default FALSE;
  286.     property Autoscroll: boolean
  287.        read FAutoscroll write FAutoscroll default FALSE;
  288.     property FileMask: string
  289.        read FFileMask write SetFileMask;
  290.  
  291.     property OnPopulated: TTVExpandedEvent
  292.        read FOnPopulated write FOnPopulated;
  293.  
  294.  
  295.     { Publish protected properties. }
  296.     property Align;
  297.     {$IFDEF DFS_COMPILER_4_UP}
  298.     property Anchors;
  299.     property AutoExpand;
  300.     property BiDiMode;
  301.     {$ENDIF}
  302.     property BorderStyle;
  303.     {$IFDEF DFS_COMPILER_4_UP}
  304.     property BorderWidth;
  305.     property ChangeDelay;
  306.     {$ENDIF}
  307.     property Color;
  308.     {$IFDEF DFS_COMPILER_4_UP}
  309.     property Constraints;
  310.     {$ENDIF}
  311.     property Ctl3D;
  312.     property DragCursor;
  313.     {$IFDEF DFS_COMPILER_4_UP}
  314.     property DragKind;
  315.     {$ENDIF}
  316.     property DragMode;
  317.     property Enabled;
  318.     property Font;
  319.     property HideSelection;
  320.     {$IFDEF DFS_COMPILER_4_UP}
  321.     property HotTrack;
  322.     {$ENDIF}
  323.     property Indent;
  324.     property OnChange;
  325.     property OnChanging;
  326.     property OnClick;
  327.     property OnCollapsed;
  328.     property OnCollapsing;
  329.     property OnCompare;
  330.     {$IFDEF DFS_COMPILER_4_UP}
  331.     property OnCustomDraw;
  332.     property OnCustomDrawItem;
  333.     {$ENDIF}
  334.     property OnDblClick;
  335.     property OnDeletion;
  336.     property OnDragDrop;
  337.     property OnDragOver;
  338.     property OnEdited;
  339.     property OnEditing;
  340.     {$IFDEF DFS_COMPILER_4_UP}
  341.     property OnEndDock;
  342.     {$ENDIF}
  343.     property OnEndDrag;
  344.     property OnEnter;
  345.     property OnExit;
  346.     property OnExpanded;
  347.     property OnExpanding;
  348.     property OnGetImageIndex;
  349.     property OnGetSelectedIndex;
  350.     property OnKeyDown;
  351.     property OnKeyPress;
  352.     property OnKeyUp;
  353.     property OnMouseDown;
  354.     property OnMouseMove;
  355.     property OnMouseUp;
  356.     {$IFDEF DFS_COMPILER_4_UP}
  357.     property OnStartDock;
  358.     {$ENDIF}
  359.     property OnStartDrag;
  360.     {$IFDEF DFS_COMPILER_4_UP}
  361.     property ParentBiDiMode;
  362.     {$ENDIF}
  363.     {$IFDEF DFS_COMPILER_2}
  364.     property ParentColor;
  365.     {$ELSE}
  366.     property ParentColor default FALSE;
  367.     {$ENDIF}
  368.     property ParentCtl3D;
  369.     property ParentFont;
  370.     property ParentShowHint;
  371.     property PopupMenu;
  372.     property ReadOnly;
  373.     {$IFDEF DFS_COMPILER_3_UP}
  374.     property RightClickSelect;
  375.     {$ENDIF}
  376.     {$IFDEF DFS_COMPILER_4_UP}
  377.     property RowSelect;
  378.     {$ENDIF}
  379.     property ShowButtons;
  380.     property ShowHint;
  381.     property ShowLines;
  382.     property ShowRoot default TRUE;
  383.     property TabOrder;
  384.     property TabStop default True;
  385.     {$IFDEF DFS_COMPILER_4_UP}
  386.     property ToolTips;
  387.     {$ENDIF}
  388.     property Visible;
  389.   end;
  390.  
  391.  
  392. {$IFDEF DFS_COMPILER_2}
  393. const
  394.   SHGDFIL_FINDDATA            = 1;
  395.   SHGDFIL_NETRESOURCE         = 2;
  396.   SHGDFIL_DESCRIPTIONID       = 3;
  397.  
  398. function SHGetDataFromIDList(psf: IShellFolder; pidl: PItemIDList;
  399.   nFormat: Integer; ptr: Pointer; cb: Integer): HResult; stdcall;
  400. {$ENDIF}
  401.  
  402. implementation
  403.  
  404.  
  405. uses
  406.   ShellAPI, MaskSearch, FileCtrl,
  407.   {$IFDEF DFS_COMPILER_4_UP} ImgList, {$ENDIF}
  408.   {$IFDEF DFS_COMPILER_3_UP} ComObj, {$ELSE} OleAuto, {$ENDIF}
  409.   {$IFDEF DFS_DEBUG} EJHkEng, {$ENDIF}
  410.   Registry;
  411.  
  412. var
  413.   NewCount: Longint;
  414.  
  415.  
  416. {$IFDEF DFS_COMPILER_2}
  417. function SHGetDataFromIDList; external 'shell32.dll' name 'SHGetDataFromIDListA';
  418. {$ENDIF}
  419.  
  420.  
  421. function DefaultTreeViewSort(Node1, Node2: TTreeNode; lParam: Integer): Integer;
  422.    stdcall;
  423. begin
  424.   // CompareIDs can probably handle NIL pointers.  need to try it.
  425.   if Node1 = Node2 then
  426.     Result := 0
  427.   else if Node1 = NIL then
  428.     Result := -1
  429.   else if Node2 = NIL then
  430.     Result := 1
  431.   else begin
  432.     if Node1.Data <> NIL then with TFolderItemData(Node1.Data) do
  433.     begin
  434.       // Status is returned in the 'code' portion (low word) of the result.
  435.       // Search for 'HResult' in Winodws.pas to read more about it.
  436.       // 0 means sort by name.
  437.       Result := shortint(SFParent.CompareIDs(0,
  438.          TFolderItemData(Node1.Data).IDList,
  439.          TFolderItemData(Node2.Data).IDList));
  440.     end else
  441.       Result := 0;
  442.   end;
  443. end;
  444.  
  445.  
  446. (*******************************************************************************
  447.   Create:
  448. *******************************************************************************)
  449. constructor TdfsSystemTreeView.Create(AOwner: TComponent);
  450. begin
  451.   inherited Create(AOwner);
  452.   // Set the defaults.
  453.   OLECheck(SHGetDesktopFolder(FDesktopFolder));
  454.   {$IFNDEF DFS_NO_COM_CLEANUP} FDesktopFolder.AddRef; {$ENDIF}
  455.   FDestroyingSelf := FALSE;
  456.   FCustomDir := '';
  457.   FLastSelection := '';
  458.   FAutoscroll := FALSE;
  459.   FPopupMenuMethod := pmmContext;
  460.   FCustomDirCaption := '';
  461.   FShowFiles := FALSE;
  462.   FShowErrorsInMsgBox := TRUE;
  463.   FRootFolder := rfDesktop;
  464.   FShowHiddenDirs := TRUE;
  465.   FExpandRoot := TRUE;
  466.   FCheckboxes := FALSE;
  467. {$IFDEF DFS_STV_FILECHANGES}
  468.   WatchedNode := NIL;
  469.   FCThread := NIL;
  470.   ParentThread := NIL;
  471.   ParentWatchedNode := NIL;
  472. {$ENDIF}
  473.   ShowRoot := TRUE;
  474.   SortType := stNone;
  475.   FFileMask := '';
  476.   FFileMaskList := TStringList.Create;
  477. end; {Create}
  478.  
  479.  
  480. (*******************************************************************************
  481.   Destroy:
  482. *******************************************************************************)
  483. destructor TdfsSystemTreeView.Destroy;
  484. begin
  485.   FDestroyingSelf := TRUE;
  486.  
  487.   {$IFDEF DFS_COMPILER_5_UP}
  488.   // This used to be in the TTreeNodes.Clear method, but in D5 it isn't done if
  489.   // the component is being destroyed.  This prevents me from freeing the data
  490.   // that has been put into each node's Data property.  I have no clue why this
  491.   // was done, so we'll just call it ourself.
  492.   // BTW, you don't want to know about FTreeHandle.  It's too bizarre...
  493.   TreeView_DeleteAllItems(FTreeHandle);
  494.   {$ENDIF}
  495.  
  496.   Selection := '';
  497.  
  498. {$IFDEF DFS_STV_FILECHANGES}
  499.   if ParentThread <> NIL then
  500.     ParentThread.Terminate;
  501.   if FCThread <> NIL then
  502.     FCThread.Terminate;
  503. {$ENDIF}
  504.  
  505.   FFileMaskList.Free;
  506.  
  507.   // Free the image list object.  Doesn't release the image list handle because
  508.   // it doesn't belong to us, but the system.  Go ahead, delete the handle and
  509.   // see what happens.  :)   It won't crash anything, but Explorer will look a
  510.   // bit strange until you reboot.
  511.   Images.Free;
  512.  
  513.   inherited Destroy;
  514.  
  515.   {$IFNDEF DFS_NO_COM_CLEANUP} FDesktopFolder.Release; {$ENDIF}
  516. //  FDesktopFolder := NIL;
  517. end; {Destroy}
  518.  
  519.  
  520. procedure TdfsSystemTreeView.CreateParams(var Params: TCreateParams);
  521. const
  522.   CheckboxesStyles: array[Boolean] of DWORD = (0, TVS_CHECKBOXES);
  523. begin
  524.   inherited CreateParams(Params);
  525.   Params.Style := Params.Style or CheckboxesStyles[FCheckboxes];
  526. end;
  527.  
  528. procedure TdfsSystemTreeView.CreateWnd;
  529. begin
  530.   FRecreatingWnd := FALSE;
  531.   inherited CreateWnd;
  532.   FTreeHandle := Handle;
  533.   // If we are loading object from stream (form file), we have to wait until
  534.   // everything is loaded before populating the list.  If we are not loading,
  535.   // i.e. the component was created dynamically or was just dropped on a form,
  536.   // we need to populate it now since the Loaded method will never get called.
  537.   if FCheckboxes then RestoreChecks;
  538.  
  539.   if not (csLoading in ComponentState) then
  540.     Reset;
  541. end;
  542.  
  543. procedure TdfsSystemTreeView.DestroyWnd;
  544. begin
  545.   // The window is only being recreated.  See CNNotify method.
  546.   FRecreatingWnd := TRUE;
  547.   if FLastSelection = '' then
  548.     FLastSelection := Selection;
  549.   if FCheckboxes then SaveChecks;
  550.  
  551.   inherited DestroyWnd;
  552. end;
  553.  
  554. procedure TdfsSystemTreeView.Loaded;
  555. begin
  556.   inherited Loaded;
  557.   Reset; // We've finished loading, we can populate the tree now.
  558. end;
  559.  
  560. function TdfsSystemTreeView.GetSelection: string;
  561. var
  562.   SelNode: TTreeNode;
  563. begin
  564.   if HandleAllocated then begin
  565.     SelNode := Selected;
  566.     if SelNode = NIL then
  567.       Result := ''
  568.     else
  569.       Result := GetNodePath(SelNode);
  570.   end else
  571.     Result := '';
  572. end;
  573.  
  574. // Searches the tree for a fully qualified PIDL, expanding as it finds nodes
  575. // that match.
  576. function TdfsSystemTreeView.FindNodeFromID(AnID: PItemIDList): TTreeNode;
  577. var
  578.   SearchID,
  579.   SimpleID,
  580.   BakID,
  581.   FQ_List: PItemIDList;
  582. //  List: PItemIDList;
  583.   Count: integer;
  584.   Node: TTreeNode;
  585.   ShellFolder: IShellFolder;
  586. begin
  587.   if (Items.Count < 1) or (AnID = NIL) then
  588.   begin
  589.     Result := NIL;
  590.     exit;
  591.   end;
  592.  
  593.   if AnID.mkid.cb = 0 then // nothing to search for.
  594.   begin
  595.     Result := Items[0];
  596.     exit;
  597.   end;
  598.  
  599.   // Initialize some stuff
  600.   Count := 0;
  601.   Node := Items[0];
  602.   if Node.Count < 1 then
  603.   begin
  604.     // No sub-nodes to search, this is as deep as it gets.
  605.     Result := Node;
  606.     exit;
  607.   end;
  608.  
  609.   with GetNodeData(Node.Item[Count]) do // Get the first item's data.
  610.   begin
  611.     SearchID := IDList; // It's relative ID
  612.     ShellFolder := SFParent; // It's parent shell folder
  613.   end;
  614.   SimpleID := CopyFirstID(AnID); // Get the relative portion of the fully
  615.                                     // qualified ID we're looking for.
  616.  
  617.   BakID := CopyFirstID(AnID); // Added by LSP
  618.   try
  619.     while assigned(SearchID) and assigned(SimpleID) do
  620.     begin
  621.       // Is the current portion of the ID we're looking for this node's child?
  622.       if ShellFolder.CompareIDs(0, SearchID, SimpleID) = 0 then
  623.       begin
  624.         // Found a match for part of the ID we're looking for.
  625.         Node := Node.Item[Count]; // Set current node to node that just matched.
  626.         AnID := NextPIDL(AnID); // Move to the next ID in the list
  627.         if AnID.mkid.cb = 0 then break; // Nothing else to find, we're done.
  628.         FreePIDL(SimpleID); // Free copy of relative ID we made
  629.         SimpleID := CopyFirstID(AnID); // Create copy of next relative part.
  630.         // Added by LSP
  631.         FQ_List := ConcatPIDLs(BakID, SimpleID);
  632.         FreePIDL(BakID);
  633.         BakID := FQ_List;
  634.         // End LSP
  635.         Node.Expand(FALSE); // Expand the matched node.
  636.         Count := 0; // Reset search index.
  637.         if Node.Count < 1 then break; // If the new node doesn't have children,
  638.                                       // we can't go any farther.
  639.       end else begin
  640.         // Didn't match with the current child of the node.
  641.         Inc(Count); // Increment the child node index
  642.         // Added by LSP
  643.         if Count >= Node.Count then break; // No more, didn't find it, get out. }
  644. (* This code was causing all manner of bugs, so I've given up on it for the moment
  645.         if Count >= Node.Count then
  646.         begin // LSP Fix
  647.           FQ_List := CopyPIDL(BakID);
  648.           List := CopyPIDL(SimpleID);
  649.           if AddNode(ShellFolder, FQ_List, List, Node) = NIL then
  650.           begin
  651.             // not added for some reason.  Free up resources.
  652.             FreePIDL(FQ_List);
  653.             FreePIDL(List);
  654.           end;
  655.           inc(Count);
  656.         end;
  657.         // End LSP
  658. *)
  659.       end; // if
  660.  
  661.       // Get the next child node's data
  662.       if Count >= Node.Count then
  663.         SearchID := NIL
  664.       else
  665.         with GetNodeData(Node.Item[Count]) do
  666.         begin
  667.           SearchID := IDList; // it's relative ID
  668.           ShellFolder := SFParent; // it's shell folder
  669.         end;
  670.     end; // while
  671.  
  672.     Result := Node; // Return the deepest match we found.
  673.   finally
  674.     FreePIDL(SimpleID); // Free up relative ID copy we createed
  675.     FreePIDL(BakID);    // Added by LSP: Free copy of backup ID we made
  676.   end;
  677. end; // FindNodeFromID
  678.  
  679.  
  680. // This will work ONLY with files or directories.  Currenly there is no way of
  681. // passing stuff like the Control Panel node.
  682. procedure TdfsSystemTreeView.SetSelection(const ASel: string);
  683.   function RelativeTo(Base, Full: string): string;
  684.   begin
  685.     if (Base <> '') and (Base[Length(Base)] <> '\') then
  686.       Base := Base + '\';
  687.     if StrLIComp(PChar(Base), PChar(Full), Length(Base)) = 0 then
  688.       Result := Copy(Full, Length(Base)+1, Length(Full))
  689.     else
  690.       Result := Full;
  691.   end;
  692. var
  693.   ShellFolder: IShellFolder;
  694.   CustomID: PItemIDList;
  695.   ChangeTo: string;
  696. begin
  697.   if ASel = '' then exit;
  698.   if (([csLoading, csReading] * ComponentState) <> []) or
  699.      (not HandleAllocated){ or (not Enabled)} then
  700.     FLastSelection := ASel
  701.   else if (Items.Count > 0) then  // Anything to search?
  702.   begin
  703.     if not Items[0].Expanded then
  704.       Items[0].Expand(FALSE);
  705.     ShellFolder := GetNodeData(Items[0].Item[0]).SFParent;
  706.     if (RootFolder in [rfDesktop, rfDrives, rfFileSystem]) then
  707.       ChangeTo := ASel
  708.     else
  709.       ChangeTo := RelativeTo(Items[0].Text, ASel);
  710.     if GetIDFromPath(ShellFolder, ChangeTo, CustomID) then
  711.     begin
  712.       Items.BeginUpdate;
  713.       try
  714.         // Find CustomID's tree node and select it.
  715.         Selected := FindNodeFromID(CustomID);
  716.         if Selected <> NIL then
  717.           Selected.MakeVisible;
  718.       finally
  719.         Items.EndUpdate;
  720.         FreePIDL(CustomID);
  721.       end; //try
  722.     end;
  723.   end;
  724. end;
  725.  
  726. function TdfsSystemTreeView.GetItemCheck(Node: TTreeNode): boolean;
  727. var
  728.   Item: TTVItem;
  729. begin
  730.   Result := FALSE;
  731.   if Node <> NIL then
  732.   begin
  733.   { Can't use this because the stupid VCL doesn't update the property when
  734.     the user clicks on it, only when you change it in code.  Got to do it the
  735.     old fashioned way...
  736.     Result := Node.StateIndex = 2;}
  737.     
  738.     FillChar(Item, SizeOf(Item), #0);
  739.     Item.mask := TVIF_STATE;
  740.     Item.hItem := Node.ItemId;
  741.     Item.stateMask := TVIS_STATEIMAGEMASK;
  742.     TreeView_GetItem(Handle, Item);
  743.     Result := (Item.State and IndexToStateImageMask(2)) <> 0;
  744.   end;
  745. end;
  746.  
  747. procedure TdfsSystemTreeView.SetItemCheck(Node: TTreeNode; Val: boolean);
  748. const
  749.   CHECKINT: array[boolean] of integer = (1, 2);
  750. begin
  751.   if Node <> NIL then
  752.   begin
  753.     Node.StateIndex := CHECKINT[Val];
  754.   end;
  755. end;
  756.  
  757.  
  758.  
  759. (*******************************************************************************
  760.   CNNotify:  Trap notification messages sent to the window.
  761.     This is damn silly, but it's the only way we can know when a node is being
  762.     deleted. I think it's an oversight in the VCL, so until Borland fixes it,
  763.     just live with it.
  764. *******************************************************************************)
  765. procedure TdfsSystemTreeView.CNNotify(var Message: TWMNotify);
  766. var
  767.   Node: TTreeNode;
  768. {$IFDEF DFS_STV_FASTMODE}
  769.   N, S: integer;
  770.   CallInh: boolean;
  771. {$ENDIF}
  772. begin
  773.   // We have to ignore the delete notification if the window is being recreated,
  774.   // that is someone did something like change our BorderStyle, because the
  775.   // items are deleted, but saved to a memory stream and then restored including
  776.   // the pointers.
  777.   if (not FRecreatingWnd) and (Message.NMHdr.code = TVN_DELETEITEM) then
  778.   begin
  779.     // If deleting an item, grab the TFolderItemData associated with it so we
  780.     // can free that up
  781. {$IFDEF DFS_DEBUG} LogUserMessage(Format('PNMTreeView: %p', [Message.NMHdr])); {$ENDIF}
  782. {$IFDEF DFS_DEBUG} if Message.NMHdr <> NIL then LogUserMessage(Format('GetNodeFromItem %p', [PNMTreeView(Pointer(Message.NMHdr))^.itemOld.hItem])); {$ENDIF}
  783.     with PNMTreeView(Pointer(Message.NMHdr))^ do
  784.       Node := GetNodeFromItem(itemOld);
  785.     if Node <> NIL then
  786.       FreeItemData(Node);
  787.   end;
  788.  
  789. {$IFDEF DFS_STV_FASTMODE}
  790.   CallInh := TRUE;
  791.  
  792.   if Message.NMHdr.code = TVN_GETDISPINFO then
  793.   begin
  794.     with PTVDispInfo(Pointer(Message.NMHdr))^.item do
  795.     begin
  796.       if (mask and TVIF_PARAM) <> 0 then
  797.         Node := TTreeNode(lParam)
  798.       else
  799.         Node := Items.GetNode(hItem);
  800.  
  801.       if (Node <> NIL) and (Node.Data <> NIL) then
  802.       begin
  803.         with TFolderItemData(Node.Data) do
  804.         begin
  805.           if (mask and (TVIF_IMAGE or TVIF_SELECTEDIMAGE)) <> 0 then
  806.           begin
  807.             GetNormalAndSelectedIcons(FQ_IDList, N, S);
  808.             if (S = 0) and (N <> 0) then
  809.               S := N;
  810.             if (mask and TVIF_IMAGE) <> 0 then
  811.             begin
  812.               if (Attributes and SFGAO_FOLDER) = 0 then
  813.                 iImage := S
  814.               else
  815.                 iImage := N;
  816.             end;
  817.             if (mask and TVIF_SELECTEDIMAGE) <> 0 then
  818.               iSelectedImage := S;
  819.             CallInh := FALSE;
  820.           end;
  821.  
  822.           // Don't ask for it again!
  823.           mask := mask or TVIF_DI_SETITEM;
  824.         end;
  825.       end;
  826.     end;
  827.   end;
  828.  
  829.  
  830.   if CallInh then
  831. {$ENDIF}
  832.     inherited;
  833. end; {CNNotify}
  834.  
  835. procedure TdfsSystemTreeView.TimerEvent;
  836. begin
  837.   inherited TimerEvent;
  838. {$IFDEF DFS_STV_FILECHANGES}
  839.   WatchDirectoryForChanges(Selected);
  840. {$ENDIF}
  841. end;
  842.  
  843.  
  844. (*******************************************************************************
  845.   CanExpand:
  846. *******************************************************************************)
  847. function TdfsSystemTreeView.CanExpand(Node: TTreeNode): boolean;
  848. var
  849.   SubFolder: IShellFolder;
  850.   NodeData: TFolderItemData;
  851. begin
  852.   Result := inherited CanExpand(Node);
  853.   if not Result then exit;
  854.  
  855.   // See if the node needs to be populated.
  856.   if Node.Data <> NIL then
  857.   begin
  858.     NodeData := GetNodeData(Node);
  859.     if not NodeData.Initialized then
  860.     begin
  861.       if (Node.Parent = NIL) and (FRootFolder = rfDesktop) then
  862.       begin
  863.         EnumerateFolders(FDesktopFolder, Node);
  864.         NodeData.Initialized := TRUE;
  865.       end else begin
  866.         OLECheck(NodeData.SFParent.BindToObject(NodeData.IDList, NIL,
  867.            IID_IShellFolder, pointer(SubFolder)));
  868.         // I can't remember why I do this first here, unlike above.
  869.         NodeData.Initialized := TRUE;
  870.         Result := EnumerateFolders(SubFolder, Node);
  871.         {$IFNDEF DFS_NO_COM_CLEANUP} SubFolder.Release; {$ENDIF}
  872.       end; //if
  873.     end; //if
  874.   end; //if
  875.  
  876.   // This usually happens on networked stuff.  It's not unusual there, and even
  877.   // Explorer does it this way, so I'm guessing I'm doing it right.  :)
  878.   if not Result then // something happened and we couldn't enum folders.
  879.     Node.HasChildren := FALSE
  880.   else
  881.     Populated(Node);
  882. end; {CanExpand}
  883.  
  884.  
  885. (*******************************************************************************
  886.   DeleteItem:
  887. *******************************************************************************)
  888. procedure TdfsSystemTreeView.DeleteItem(Node: TTreeNode);
  889. begin
  890.   if Node = NIL then exit;
  891.   FreeItemData(Node);
  892.   Node.Delete;
  893. end; {DeleteItem}
  894.  
  895.  
  896. function TdfsSystemTreeView.GetNodeFromItem(const Item: TTVItem): TTreeNode;
  897. begin
  898.   with Item do
  899.     if (state and TVIF_PARAM) <> 0 then
  900.       Result := Pointer(lParam)
  901.     else
  902.       Result := Items.GetNode(hItem);
  903. end;
  904.  
  905.  
  906. function TdfsSystemTreeView.GetFolderID: integer;
  907. const
  908.   CSIDL_CUSTOM  = $EAFE;
  909.   FOLDERID : array[rfDesktop..rfCustom] of integer = (
  910.      CSIDL_DESKTOP, CSIDL_BITBUCKET, CSIDL_CONTROLS, CSIDL_DESKTOPDIRECTORY,
  911.      CSIDL_DRIVES, CSIDL_FAVORITES, CSIDL_FONTS, CSIDL_NETWORK, CSIDL_NETHOOD,
  912.      CSIDL_PERSONAL, CSIDL_PRINTERS, CSIDL_PROGRAMS, CSIDL_RECENT, CSIDL_SENDTO,
  913.      CSIDL_STARTMENU, CSIDL_STARTUP, CSIDL_TEMPLATES, CSIDL_DRIVES, CSIDL_CUSTOM
  914.    );
  915. begin
  916.   Result := FOLDERID[FRootFolder];
  917. end;
  918.  
  919.  
  920. function TdfsSystemTreeView.GetItems: TTreeNodes;
  921. begin
  922.   Result := inherited Items;
  923. end;
  924.  
  925.  
  926. procedure TdfsSystemTreeView.SetShowFiles(Val: boolean);
  927. begin
  928.   if Val = FShowFiles then exit;
  929.   FShowFiles := Val;
  930.   Reset;
  931. end;
  932.  
  933. procedure TdfsSystemTreeView.SetFileMask(const Val: string);
  934. begin
  935.   if Val = FFileMask then exit;
  936.   FFileMask := Val;
  937.   MaskSearch.BuildMask(FFileMask, FFileMaskList);
  938.   Reset;
  939. end;
  940.  
  941. procedure TdfsSystemTreeView.SetCustomDir(const Val: string);
  942. begin
  943.   if Val = FCustomDir then exit;
  944.   FCustomDir := Val;
  945.   Reset;
  946. end;
  947.  
  948.  
  949. procedure TdfsSystemTreeView.SetCustomDirCaption(const Val: string);
  950. begin
  951.   if FCustomDirCaption = Val then exit;
  952.   FCustomDirCaption := Val;
  953.   if Items.Count > 0 then
  954.     Items[0].Text := FCustomDirCaption;
  955. end;
  956.  
  957. procedure TdfsSystemTreeView.RestoreChecks;
  958. begin
  959.   // Unimplemented
  960. end;
  961.  
  962. procedure TdfsSystemTreeView.SaveChecks;
  963. begin
  964.   // Unimplemented
  965. end;
  966.  
  967. procedure TdfsSystemTreeView.SetCheckboxes(Val: boolean);
  968. begin
  969.   if Val <> FCheckboxes then
  970.   begin
  971.     FCheckboxes := Val;
  972.     if HandleAllocated then
  973.     begin
  974.       RecreateWnd;
  975.       if FCheckboxes then RestoreChecks;
  976.     end;
  977.   end;
  978. end;
  979.  
  980. function TdfsSystemTreeView.GetIDFromPath(const ShellFolder: IShellFolder;
  981.    const APath: string; var ID: PItemIDList): boolean;
  982. var
  983.   OLEStr: array[0..MAX_PATH] of TOLEChar;
  984.   Eaten: ULONG;
  985.   Attr: ULONG;
  986. begin
  987.   try
  988.     Result := TRUE;
  989.     OLECheck(ShellFolder.ParseDisplayName(GetValidHandle, NIL,
  990.        StringToWideChar(APath, OLEStr, MAX_PATH), Eaten, ID, Attr));
  991.   except
  992.     Result := FALSE;
  993.   end;
  994. end;
  995.  
  996.  
  997. (*******************************************************************************
  998.   ResetTreeView:
  999. *******************************************************************************)
  1000. procedure TdfsSystemTreeView.Reset;
  1001. var
  1002.   RootNode: TTreeNode;
  1003.   RootID: PItemIDList;
  1004.   Success: boolean;
  1005.   FindID,
  1006.   CurrentNodeID: PItemIDList;
  1007.   CurrentNodeExpanded: boolean;
  1008.   OldInhibit: boolean;
  1009. begin
  1010.   // If we don't have a window handle or are in the loading state, DON'T do
  1011.   // this stuff.  When the handle is created or the loading is finished, we
  1012.   // will call this again.
  1013.   if (not HandleAllocated) or (csLoading in ComponentState) then
  1014.     exit;
  1015.  
  1016.   // If we have a selection, stash the node ID so we can find it after
  1017.   // resetting. All of the node data is going to get cleared, so we have to
  1018.   // copy the selected ID, not just store the the current pointer.
  1019.   if (Selected <> NIL) and (Selected.Data <> NIL) and
  1020.      (TFolderItemData(Selected.Data).FQ_IDList <> NIL) then
  1021.   begin
  1022.     CurrentNodeID := CopyPIDL(TFolderItemData(Selected.Data).FQ_IDList);
  1023.     CurrentNodeExpanded := Selected.Expanded;
  1024.   end
  1025.   else
  1026.   begin
  1027.     CurrentNodeID := NIL;
  1028.     CurrentNodeExpanded := FALSE;
  1029.   end;
  1030.   OldInhibit := InhibitReadDelay;
  1031.   InhibitReadDelay := TRUE;
  1032.   Items.BeginUpdate;
  1033.   try
  1034.     // Clear old stuff
  1035.     Selected := NIL;
  1036.     FreeAllItemData;
  1037.     Items.Clear;
  1038.  
  1039.     if (FRootFolder = rfCustom) then
  1040.       Success := GetIDFromPath(FDesktopFolder, FCustomDir, RootID)
  1041.     else
  1042.       Success := SUCCEEDED(SHGetSpecialFolderLocation(GetValidHandle,
  1043.          GetFolderID, RootID));
  1044.  
  1045.     if Success then
  1046.     begin
  1047.       RootNode := AddNode(FDesktopFolder, ConcatPIDLs(NIL, RootID), RootID, NIL);
  1048.       if FExpandRoot and assigned(RootNode) and (Items.Count > 0) then
  1049.         RootNode.Expand(FALSE);
  1050.     end; //if
  1051.  
  1052.     if SortType <> stNone then
  1053.       AlphaSort;
  1054.  
  1055.     if FLastSelection <> '' then
  1056.     begin
  1057.       Selection := FLastSelection;
  1058.       FLastSelection := '';
  1059.     end
  1060.     else if CurrentNodeID <> NIL then
  1061.     begin
  1062.       // Adjust for the lack of a "Desktop" node since FQ pidls do include it.
  1063.       if RootFolder in [rfFileSystem, rfDrives] then
  1064.         FindID := NextPIDL(CurrentNodeID) // Move to the next ID in the list}
  1065.       else
  1066.         FindID := CurrentNodeID;
  1067.  
  1068.       Selected := FindNodeFromID(FindID);
  1069.       if Selected <> NIL then
  1070.       begin
  1071.         Selected.MakeVisible;
  1072.         if CurrentNodeExpanded and CanExpand(Selected) then
  1073.           Selected.Expand(FALSE);
  1074.       end;
  1075.     end;
  1076.  
  1077.   finally
  1078.     Items.EndUpdate;
  1079.     InhibitReadDelay := OldInhibit;
  1080.     FreePIDL(CurrentNodeID);
  1081.   end;
  1082.  
  1083.   inherited Reset;
  1084. end; {Reset}
  1085.  
  1086.  
  1087. (*******************************************************************************
  1088.   EnumerateFolders:
  1089. *******************************************************************************)
  1090. function TdfsSystemTreeView.EnumerateFolders(const ShellFolder: IShellFolder;
  1091.    const ParentNode: TTreeNode): boolean;
  1092. var
  1093.   Flags: DWORD;
  1094.   EnumList: IEnumIDList;
  1095.   FQ_List,
  1096.   List: PItemIDList;
  1097.   Fetched: ULONG;
  1098.   OldCursor: TCursor;
  1099. begin
  1100.   Result := FALSE;
  1101.   // Inhibit screen painting for speed
  1102.   Items.BeginUpdate;
  1103.   // I wish there was some way to find out the number of items being enumerated,
  1104.   // and only set the hourglass cursor if there were many of them....
  1105.   OldCursor := Cursor;
  1106.   Cursor := crHourglass;
  1107.   try
  1108.     Flags := SHCONTF_FOLDERS;
  1109.     if FShowHiddenDirs then
  1110.       Flags := Flags or SHCONTF_INCLUDEHIDDEN;
  1111.     if FShowFiles then
  1112.       Flags := Flags or SHCONTF_NONFOLDERS;
  1113.     if SUCCEEDED(ShellFolder.EnumObjects(GetValidHandle, Flags, EnumList)) then
  1114.     begin
  1115.       // Walk the folders. The list will be saved so don't free it anywhere.
  1116.       while EnumList.Next(1, List, Fetched) = S_OK do
  1117.       begin
  1118.         Result := TRUE;  // only successful if we enumerated at least once.
  1119.         if assigned(ParentNode) then
  1120.           with TFolderItemData(ParentNode.Data) do
  1121.             FQ_List := ConcatPIDLs(FQ_IDList, List)
  1122.         else
  1123.           FQ_List := ConcatPIDLs(NIL, List);
  1124.  
  1125.         if AddNode(ShellFolder, FQ_List, List, ParentNode) = NIL then
  1126.         begin
  1127.           // not added for some reason.  Free up resources.
  1128.           FreePIDL(FQ_List);
  1129.           FreePIDL(List);
  1130.         end;
  1131.       end; {while}
  1132.       {$IFNDEF DFS_NO_COM_CLEANUP} EnumList.Release; {$ENDIF}
  1133.     end else
  1134.       // Maybe an event for this???  No items to enum when there should be.
  1135.       ;
  1136.   finally
  1137.     // always protect this stuff to make sure it gets reset.
  1138.     Items.EndUpdate;
  1139.     Cursor := OldCursor;
  1140.   end;
  1141. end;
  1142.  
  1143.  
  1144. (*******************************************************************************
  1145.   AddNode:
  1146. *******************************************************************************)
  1147. function TdfsSystemTreeView.AddNode(const ShellFolder: IShellFolder;
  1148.    FQ_IDList, IDList: PItemIDList; const ParentNode: TTreeNode): TTreeNode;
  1149. var
  1150.   NiceName, FullName: string;
  1151.   Flags: DWORD;
  1152.   Attrs: UINT;
  1153. {$IFNDEF DFS_STV_FASTMODE}
  1154.   Normal,
  1155.   Selected: integer;
  1156. {$ENDIF}
  1157.   EnumList: IEnumIDList;
  1158.   List: PItemIDList;
  1159.   Fetched: ULONG;
  1160.   SubFolder: IShellFolder;
  1161.   NodeData: TFolderItemData;
  1162.   NoPIDL: PItemIDList;
  1163. begin
  1164.   Result := NIL;
  1165.   NoPIDL := NIL;
  1166.   Attrs := SFGAO_VALIDATE;
  1167.   // Invalidate cached information.
  1168.   ShellFolder.GetAttributesOf(0, NoPIDL, Attrs);
  1169. { This fails for UNC names at root.....
  1170.   if GetNiceName(ShellFolder, IDList, SHGDN_NORMAL, NiceName) then begin}
  1171.   NiceName := GetDisplayName(ShellFolder, IDList, dntNormal);
  1172.   begin
  1173.     if (ParentNode = NIL) and (FRootFolder = rfCustom) and
  1174.        (FCustomDirCaption <> '') then
  1175.       NiceName := FCustomDirCaption;
  1176.     // SFGAO_CONTENTSMASK is incorrect in the SDK header (not Borland's fault).
  1177.     Attrs := SFGAO_CAPABILITYMASK or SFGAO_DISPLAYATTRMASK and
  1178.        (not SFGAO_READONLY) or SFGAO_REMOVABLE or $F0000000{SFGAO_CONTENTSMASK};
  1179.     ShellFolder.GetAttributesOf(1, IDList, Attrs);
  1180.     if (FRootFolder = rfFileSystem) and
  1181.        ((Attrs and (SFGAO_FILESYSTEM or SFGAO_FILESYSANCESTOR)) = 0) then exit;
  1182.  
  1183.     // mask!
  1184.     if (FFileMask <> '') and ((Attrs and SFGAO_FOLDER) = 0) then
  1185.     begin
  1186.       SetLength(FullName, MAX_PATH);
  1187.       if SHGetPathFromIDList(FQ_IDList, PChar(FullName)) then
  1188.       begin
  1189.         SetLength(FullName, StrLen(PChar(FullName)));
  1190.         if not MaskSearch.FileMatches(FullName, FFileMaskList) then
  1191.         begin
  1192.           Result := NIL;
  1193. { Removed by LSP
  1194.           FreePIDL(IDList);
  1195.           FreePIDL(FQ_IDList);}
  1196.           exit;
  1197.         end;
  1198.       end;
  1199.     end;
  1200.  
  1201.     Result := Items.AddChildObject(ParentNode, NiceName,
  1202.        AddItemData(ShellFolder, IDList, FQ_IDList, Attrs));
  1203.  
  1204. {$IFNDEF DFS_STV_FASTMODE}
  1205.     GetNormalAndSelectedIcons(FQ_IDList, Normal, Selected);
  1206.  
  1207.     if (Selected = 0) and (Normal <> 0) then
  1208.       Selected := Normal;
  1209.  
  1210.     if (Attrs and SFGAO_FOLDER) = 0 then
  1211.     begin
  1212.       Result.ImageIndex := Selected;
  1213.       Result.SelectedIndex := Selected;
  1214.     end else begin
  1215.       Result.ImageIndex := Normal;
  1216.       Result.SelectedIndex := Selected;
  1217.     end;
  1218. {$ENDIF}
  1219.  
  1220.     // added by Peter Ruskin 26/09/97 to get the share and link icons
  1221.     // Modified just a bit by Brad Stowers.
  1222.     if (SFGAO_SHARE and Attrs) <> 0 then { $20000 if shared }
  1223.     begin
  1224.       Result.OverlayIndex := 0;        { you can have four of these (0..3) }
  1225. // Causes incorrect overlay on some machines.  Shouldn't be necessary.
  1226. //      Images.Overlay(28, 0);   { 28 is index of share "hand" in Shell32.dll }
  1227.     end;   // share icons
  1228.  
  1229.     if (SFGAO_LINK and Attrs) <> 0 then { $00010000 if shared }
  1230.     begin
  1231.       Result.OverlayIndex := 1;        { you can have four of these (0..3) }
  1232. // Causes incorrect overlay on some machines.  Shouldn't be necessary.
  1233. //      Images.Overlay(29, 1);   { 29 is index of link "arrow" in Shell32.dll }
  1234.     end;   // link (Shortcut) icons
  1235.     // end changes by Peter Ruskin
  1236.  
  1237.     Result.HasChildren := (Result.Data <> NIL) and
  1238.        (TFolderItemData(Result.Data).ItemHasFlag(SFGAO_HASSUBFOLDER));
  1239.     if FShowFiles and (not Result.HasChildren) then
  1240.     begin
  1241.       // see if enum can find anything
  1242.       NodeData := TFolderItemData(Result.Data);
  1243.       if (ShellFolder.BindToObject(NodeData.IDList, NIL, IID_IShellFolder,
  1244.          pointer(SubFolder))) = S_OK then
  1245.       begin
  1246.         Flags := SHCONTF_NONFOLDERS;
  1247.         if ShowHiddenDirs then
  1248.           Flags := Flags or SHCONTF_INCLUDEHIDDEN;
  1249.         if SUCCEEDED(SubFolder.EnumObjects(GetValidHandle, Flags,
  1250.            EnumList)) then
  1251.         begin
  1252.           Result.HasChildren := TRUE;
  1253.           if EnumList.Next(1, List, Fetched) = S_OK then
  1254.             Result.HasChildren := Fetched > 0;
  1255.           FreePIDL(List);
  1256.           {$IFNDEF DFS_NO_COM_CLEANUP} EnumList.Release; {$ENDIF}
  1257.         end;
  1258.         {$IFNDEF DFS_NO_COM_CLEANUP} SubFolder.Release; {$ENDIF}
  1259.       end;
  1260.     end;
  1261.   end; {if}
  1262. end; {AddNode}
  1263.  
  1264.  
  1265. (*******************************************************************************
  1266.   AddItemData:
  1267. *******************************************************************************)
  1268. function TdfsSystemTreeView.AddItemData(ItemFolder: IShellFolder;
  1269.    aIDList, aFQ_IDList: PItemIDList; Attrs: UINT): TFolderItemData;
  1270. begin
  1271.   Result := TFolderItemData.Create;
  1272.   with Result do
  1273.   begin
  1274.     Initialized := FALSE;
  1275.     SFParent := ItemFolder;
  1276.     {$IFNDEF DFS_NO_COM_CLEANUP} SFParent.AddRef; {$ENDIF}
  1277.     IDList := aIDList;
  1278.     FQ_IDList := aFQ_IDList;
  1279.     Attributes := Attrs;
  1280.     FileSizeHigh := 0;
  1281.     FileSizeLow := 0;
  1282.   end;
  1283.   inc(NewCount);
  1284. end; {AddItemDta}
  1285.  
  1286.  
  1287. (*******************************************************************************
  1288.   FreeItemData:
  1289. *******************************************************************************)
  1290. procedure TdfsSystemTreeView.FreeItemData(Item: TTreeNode);
  1291. begin
  1292.   if Item.Data <> NIL then
  1293.   begin
  1294.     with GetNodeData(Item) do
  1295.     begin
  1296.       FreePIDL(FIDList);
  1297.       FreePIDL(FFQ_IDList);
  1298.       {$IFNDEF DFS_NO_COM_CLEANUP}
  1299.       if SFParent <> NIL then
  1300.         SFParent.Release;
  1301.       {$ENDIF}
  1302.     end;
  1303.     TFolderItemData(Item.Data).Free;
  1304.     // For some reason, setting Data to NIL is blowing up in D5. Bizarre.
  1305.     if not (csDestroying in ComponentState) then
  1306.       Item.Data := NIL;
  1307.     dec(NewCount);
  1308.   end;
  1309. end; {FreeItemData}
  1310.  
  1311.  
  1312. (*******************************************************************************
  1313.   FreeAllItemData:
  1314. *******************************************************************************)
  1315. procedure TdfsSystemTreeView.FreeAllItemData;
  1316. var
  1317.   x: integer;
  1318. begin
  1319.   for x := 0 to Items.Count-1 do
  1320.     FreeItemData(Items[x]);
  1321. (* This is old stuff that isn't needed any more.  list doesn't share pointers
  1322.    starting with v0.96
  1323. {$IFDEF DFS_SCP_SYSLISTVIEW}
  1324.   // Make sure list view doesn't keep an invalid node pointer.
  1325.   if (FListView <> NIL) then
  1326.     ListView.FLastNode := NIL;
  1327. {$ENDIF}
  1328. *)
  1329. end; {FreeAllItemData}
  1330.  
  1331.  
  1332. (*******************************************************************************
  1333.   SetRootFolder:
  1334. *******************************************************************************)
  1335. procedure TdfsSystemTreeView.SetRootFolder(Val: TRootFolder);
  1336. begin
  1337.   if Val = FRootFolder then exit;
  1338.   FRootFolder := Val;
  1339.   Reset;
  1340. end; {SetRootFolder}
  1341.  
  1342.  
  1343. (*******************************************************************************
  1344.   DisplayContextMenu:
  1345. *******************************************************************************)
  1346. function TdfsSystemTreeView.DisplayContextMenu(Node: TTreeNode;
  1347.    Where: TPoint): boolean;
  1348. var
  1349.   ItemData: TFolderItemData;
  1350.   WantsToRename: boolean;
  1351. begin
  1352.   ItemData := GetNodeData(Node);
  1353.   if (ItemData <> NIL) and (ItemData.IDList <> NIL) then
  1354.   begin
  1355. {$IFDEF DFS_COMPILER_4_UP}
  1356.     Result := ItemProp.DisplayContextMenu(ItemData.SFParent,
  1357.        ItemData.FIDList, ItemData.Attributes, DFS_HWND(Handle), Where, 1, TRUE,
  1358.        WantsToRename);
  1359. {$ELSE}
  1360.     Result := ItemProp.DisplayContextMenuPIDL(ItemData.SFParent,
  1361.        ItemData.FIDList, ItemData.Attributes,
  1362.        {$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, Where, 1,
  1363.        TRUE, WantsToRename);
  1364. {$ENDIF}
  1365.     if WantsToRename then
  1366.       Node.EditText;
  1367.   end
  1368.   else
  1369.     Result := FALSE;
  1370. end;
  1371.  
  1372. function TdfsSystemTreeView.GetItemData(Index: integer): TFolderItemData;
  1373. begin
  1374.   Result := GetNodeData(Items[Index]);
  1375. end;
  1376.  
  1377. function TdfsSystemTreeView.GetNodeData(Node: TTreeNode): TFolderItemData;
  1378. begin
  1379.   Result := NIL;
  1380.   if Node <> NIL then
  1381.   begin
  1382.     Result := Node.Data;
  1383.     if Result = NIL then
  1384.     begin
  1385.       if FShowErrorsInMsgBox then
  1386.         MessageDlg(LoadStr(IDS_NOFOLDERDATA), mtError, [mbOK], 0)
  1387.       else
  1388.         raise ENoFolderData.Create(LoadStr(IDS_NOFOLDERDATA));
  1389.     end;
  1390.   end;
  1391. end;
  1392.  
  1393. procedure TdfsSystemTreeView.Expand(Node: TTreeNode);
  1394. {$IFDEF DFS_DEBUG}
  1395. var
  1396.   TC: DWORD;
  1397. {$ENDIF}
  1398. begin
  1399. {$IFDEF DFS_DEBUG} TC := timeGetTime; {$ENDIF}
  1400.   Items.BeginUpdate;
  1401.   try
  1402.     Node.CustomSort(@DefaultTreeViewSort, 0);
  1403.   finally
  1404.     Items.EndUpdate;
  1405.   end;
  1406.  
  1407.   inherited Expand(Node);
  1408. end;
  1409.  
  1410. function TdfsSystemTreeView.CustomSort(SortProc: TTVCompare;
  1411.    Data: Longint): Boolean;
  1412. var
  1413.   SortCB: TTVSortCB;
  1414.   Node: TTreeNode;
  1415. begin
  1416.   Result := False;
  1417.   if not HandleAllocated then exit;
  1418.   with SortCB do
  1419.   begin
  1420.     if not Assigned(SortProc) then
  1421.       lpfnCompare := @DefaultTreeViewSort
  1422.     else
  1423.       lpfnCompare := SortProc;
  1424.     hParent := TVI_ROOT;
  1425.     lParam := Data;
  1426.     Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
  1427.   end; // with
  1428.  
  1429.   if (Items.Count > 0) then
  1430.   begin
  1431.     Node := Items.GetFirstNode;
  1432.     while (Node <> nil) do
  1433.     begin
  1434.       if Node.HasChildren then
  1435.         Node.CustomSort(@DefaultTreeViewSort, Data);
  1436.       Node := Node.GetNext;
  1437.     end; // while
  1438.   end; // if
  1439. end; // CustomSort
  1440.  
  1441.  
  1442. function TdfsSystemTreeView.AlphaSort: Boolean;
  1443. begin
  1444.   if HandleAllocated then
  1445.   begin
  1446.     Items.BeginUpdate;
  1447.     try
  1448.       Result := CustomSort(@DefaultTreeViewSort, 0);
  1449.     finally
  1450.       Items.EndUpdate;
  1451.     end;
  1452.   end else
  1453.     Result := False;
  1454. end;
  1455.  
  1456.  
  1457. procedure TdfsSystemTreeView.DblClick;
  1458. begin
  1459.   inherited DblClick;
  1460. end;
  1461.  
  1462. function TdfsSystemTreeView.GetPopupMenu: TPopupMenu;
  1463. begin
  1464.   if FPopupMenuMethod in [pmmUser, pmmContextUser] then
  1465.     Result := inherited GetPopupMenu
  1466.   else
  1467.     Result := NIL;
  1468. end;
  1469.  
  1470. {$IFDEF DFS_COMPILER_5_UP}
  1471. procedure TdfsSystemTreeView.WMContextMenu(var Message: TWMContextMenu);
  1472. {$ELSE}
  1473. procedure TdfsSystemTreeView.WMRButtonUp(var Message: TWMRButtonUp);
  1474. {$ENDIF}
  1475. var
  1476.   SelNode: TTreeNode;
  1477.   Pt: TPoint;
  1478. begin
  1479.   case FPopupMenuMethod of
  1480.     pmmContext,
  1481.     pmmContextUser:
  1482.       begin
  1483.         {$IFDEF DFS_COMPILER_5_UP}
  1484.         Pt := ScreenToClient(Point(Message.XPos, Message.YPos));
  1485.         {$ELSE}
  1486.         Pt := Point(Message.XPos, Message.YPos);
  1487.         {$ENDIF}
  1488.         SelNode := GetNodeAt(Pt.x, Pt.y);
  1489.         if SelNode <> NIL then
  1490.         begin
  1491.           Selected := SelNode;
  1492.           if DisplayContextMenu(SelNode, ClientToScreen(Pt)) then
  1493.             Message.Result := 1;
  1494.         end;
  1495.       end;
  1496.   end;
  1497.   inherited;
  1498. end;
  1499.  
  1500.  
  1501. procedure TdfsSystemTreeView.ResetNode(const Node: TTreeNode);
  1502. var
  1503.   RedoExpand: boolean;
  1504. begin
  1505.   if Node = NIL then exit;
  1506.   RedoExpand := Node.Expanded;
  1507.   Node.DeleteChildren;
  1508.   if Node.Data <> NIL then
  1509.   begin
  1510.     GetNodeData(Node).Initialized := FALSE;
  1511.     if CanExpand(Node) and RedoExpand then
  1512.       Node.Expand(FALSE);
  1513. //!!! Old v0.95 code.  Notification below should be enough for new version.
  1514. (*
  1515. {$IFDEF DFS_SCP_SYSLISTVIEW}
  1516.     if (FListView <> NIL) then
  1517.       FListView.ResetNode(Node, (RootFolder = rfDesktop) and
  1518.          (Selected.AbsoluteIndex = 0));
  1519. {$ENDIF}
  1520. {$IFDEF DFS_SCP_SYSCOMBOBOX}
  1521.     if (FComboBox <> NIL) then
  1522.       FComboBox.ActiveFolderIDList :=
  1523.          CopyPIDL(TFolderItemData(Node.Data).FQ_IDList);
  1524. {$ENDIF}
  1525. *)
  1526.   end;
  1527.   NotifyLinkedControls(TRUE);
  1528. end;
  1529.  
  1530.  
  1531. (*******************************************************************************
  1532.   CanEdit - 29/8/96 (By Thomas AW Brown)
  1533. *******************************************************************************)
  1534. function TdfsSystemTreeView.CanEdit(Node: TTreeNode): boolean;
  1535. begin
  1536.   Result := (Node.Data <> NIL) and NodeData[Node].ItemHasFlag(SFGAO_CANRENAME);
  1537. end;
  1538.  
  1539. (*******************************************************************************
  1540.   Edit - 29/8/96 (By Thomas AW Brown)
  1541.        - 11/9/96 Moved guts of it to RenameNode so it could be used
  1542.                  programatically. (bds)
  1543. *******************************************************************************)
  1544. procedure TdfsSystemTreeView.Edit(const Item: TTVItem);
  1545. begin
  1546.   if RenameNode(GetNodeFromItem(Item), Item.pszText) then
  1547.     inherited Edit(Item);
  1548. end;
  1549.  
  1550. {$IFDEF DFS_STV_FILECHANGES}
  1551. procedure TdfsSystemTreeView.WatchDirectoryForChanges(const ANode: TTreeNode);
  1552. var
  1553.   APath: string;
  1554.   WatchedAttrs: TFSFilterSet;
  1555. begin
  1556.   if ParentThread <> NIL then
  1557.   begin
  1558.     ParentThread.Terminate;
  1559.     ParentThread := NIL;
  1560.     ParentWatchedNode := NIL;
  1561.   end;
  1562.   if FCThread <> NIL then
  1563.   begin
  1564.     FCThread.Terminate;  // it will destroy itself.
  1565.     FCThread := NIL;
  1566.     WatchedNode := NIL;
  1567.   end;
  1568.   APath := GetNodePath(ANode);
  1569.   if ShowFiles and FileExists(APath) then
  1570.     APath := ExtractFilePath(APath);
  1571.   if (APath <> '') then
  1572.   begin
  1573.     WatchedNode := ANode;
  1574. {$IFDEF DFS_SCP_SYSLISTVIEW}
  1575.     if (ListView <> NIL) or ShowFiles then
  1576.       WatchedAttrs := [fsfFilename, fsfDirname, fsfAttributes, fsfSize,
  1577.          fsfLastWrite]
  1578.     else
  1579. {$ELSE}
  1580.     if ShowFiles then
  1581. {$ENDIF}
  1582.       WatchedAttrs := [fsfDirname];
  1583.     FCThread := TFileChangeThread.Create(APath, WatchedAttrs, FALSE);
  1584.     FCThread.OnTerminate := ThreadDone;
  1585.  
  1586.   { Have to watch the parent node as well in case the one we are in does
  1587.     something -- like get deleted }
  1588.     ParentWatchedNode := WatchedNode.Parent;
  1589.     if ParentWatchedNode <> NIL then
  1590.     begin
  1591.       APath := GetNodePath(ParentWatchedNode);
  1592.       if (APath <> '') then
  1593.       begin
  1594.         ParentThread := TFileChangeThread.Create(APath, [fsfDirname], FALSE);
  1595.         ParentThread.OnTerminate := ParentThreadDone;
  1596.       end;
  1597.     end;
  1598.   end;
  1599. end;
  1600.  
  1601. procedure TdfsSystemTreeView.ThreadDone(Sender: TObject);
  1602. var
  1603.   Temp: TTreeNode;
  1604.   TExpanded : Boolean;
  1605.   dir: string;
  1606. begin
  1607.   FCThread := NIL;
  1608.   // Don't need to watch the parent any more.
  1609.   if ParentThread <> NIL then
  1610.   begin
  1611.     ParentWatchedNode := NIL;
  1612.     ParentThread.Terminate;
  1613.     ParentThread := NIL;
  1614.   end;
  1615.   // we need to make sure that the directory we are watching hasn't been
  1616.   // deleted or moved
  1617.   Items.BeginUpdate;
  1618.   try
  1619.     dir := GetNodePath(WatchedNode);
  1620.     if dir = '' then exit;
  1621.     if not DirectoryExists(dir) then
  1622.     begin
  1623.       if FileExists(dir) then // is it file that the user selected?
  1624.         WatchDirectoryForChanges(WatchedNode.Parent)
  1625.       else begin
  1626.         Temp := WatchedNode.Parent;
  1627.         TExpanded := Temp.Expanded;
  1628.         ResetNode(Temp);
  1629.         if TExpanded then
  1630.         begin
  1631.           Temp.Expand(False);
  1632.           Temp.MakeVisible;
  1633.         end;
  1634.         Selected := Temp;
  1635.       end;
  1636.     end else begin
  1637.       Temp := WatchedNode;
  1638.       TExpanded := Temp.Expanded;
  1639.       WatchedNode := NIL;
  1640.       ResetNode(Temp);
  1641.       if TExpanded then
  1642.       begin
  1643.         Temp.Expand(False);
  1644.         Temp.MakeVisible;
  1645.       end;
  1646.       WatchDirectoryForChanges(Temp);
  1647.     end;
  1648.   finally
  1649.     Items.EndUpdate;
  1650.   end;
  1651. end;
  1652.  
  1653. procedure TdfsSystemTreeView.ParentThreadDone(Sender: TObject);
  1654. begin
  1655.   ParentThread := NIL;
  1656.   // Check to see if the directory currently selected has been deleted or renamed
  1657.   if not DirectoryExists(GetNodePath(WatchedNode)) then
  1658.   begin
  1659.     Selected := ParentWatchedNode;
  1660.     Reset;
  1661.   end;
  1662. end;
  1663. {$ENDIF}
  1664.  
  1665. function TdfsSystemTreeView.GetNodePath(const Node: TTreeNode): string;
  1666. begin
  1667.   Result := '';
  1668.   if (Node <> NIL) and (Node.Data <> NIL) then
  1669.   begin
  1670.     SetLength(Result, MAX_PATH);
  1671.     if SHGetPathFromIDList(GetNodeData(Node).FQ_IDList, PChar(Result)) then
  1672.       SetLength(Result, StrLen(PChar(Result)))
  1673.     else
  1674.       Result := '';
  1675.   end;
  1676. end;
  1677.  
  1678.  
  1679. procedure TdfsSystemTreeView.Change(Node: TTreeNode);
  1680. var
  1681.   OldCursor : TCursor;
  1682. begin
  1683.   if FDestroyingSelf then
  1684.     exit;
  1685.  
  1686.   OldCursor := Cursor;
  1687.   Cursor := crHourglass;
  1688.  
  1689.   inherited Change(Node);
  1690.  
  1691.   {$IFDEF DFS_STV_FILECHANGES}
  1692.   if (ReadDelay < 1) and (Selected <> NIL) and (Selected.Data <> NIL) then
  1693.     WatchDirectoryForChanges(Selected);
  1694.   {$ENDIF}
  1695.  
  1696.   Cursor := OldCursor;
  1697. end;
  1698.  
  1699.  
  1700. procedure TdfsSystemTreeView.DoStartDrag(var DragObject: TDragObject);
  1701. begin
  1702.   inherited DoStartDrag(DragObject);
  1703. //  DoDragDrop
  1704. end;
  1705.  
  1706.  
  1707. function TdfsSystemTreeView.RenameNode(const Node: TTreeNode;
  1708.    const NewName: string): boolean;
  1709. var
  1710.   pstr: PWideChar;
  1711.   AnIDList: PItemIDList;
  1712. begin
  1713.   Result := FALSE;
  1714.   if (Node = NIL) or (Node.Data = NIL) or (NewName = '') then exit;
  1715.  
  1716.   pstr := StringToOleStr(NewName); //make an OLE string for SetNameOf
  1717.   try
  1718.     with GetNodeData(Node) do
  1719.     begin
  1720.       AnIDList := CreatePIDL(1);
  1721.       // SetNameOf will free the first IDList passed and return the new IDList
  1722.       // in the second PIDL parameter.
  1723.       Result := SUCCEEDED(SFParent.SetNameOf(GetValidHandle, IDList, pstr,
  1724.          SHCONTF_FOLDERS, AnIDList));
  1725.       if Result then
  1726.       begin
  1727.         Node.Text := NewName;
  1728.         IDList := AnIDList;
  1729.         if (assigned(Node.Parent) and (assigned(Node.Parent.Data))) then
  1730.           FQ_IDList := ConcatPIDLS(TFolderItemData(Node.Parent.Data).FQ_IDList,
  1731.              IDList)
  1732.         else
  1733.           FQ_IDList := ConcatPIDLs(NIL, IDList);
  1734.       end;
  1735.     end;
  1736.   finally
  1737.     ShellMalloc.Free(pstr); // Don't forget to free the OLE string
  1738.   end;
  1739. end;
  1740.  
  1741. function TdfsSystemTreeView.DeleteNode(const Node: TTreeNode): boolean;
  1742. var
  1743.   ItemData: TFolderItemData;
  1744. begin
  1745.   Result := FALSE;
  1746.   ItemData := GetNodeData(Node);
  1747.   if (ItemData <> NIL) and (ItemData.IDList <> NIL) then
  1748.  
  1749. (*
  1750.   Dir := GetNodePath(Node);
  1751.   if Dir = '' then exit;
  1752.   Result := RemoveDirectory(PChar(Dir));
  1753.   if Result then
  1754.     DeleteItem(Node);
  1755. *)
  1756. {$IFDEF DFS_COMPILER_4_UP}
  1757.     Result := ItemProp.PerformVerb('delete', ItemData.SFParent, ItemData.FIDList,
  1758.        ItemData.Attributes, DFS_HWND(Handle), 1);
  1759. {$ELSE}
  1760.     Result := ItemProp.PerformVerbPIDL('delete', ItemData.SFParent,
  1761.        ItemData.FIDList, ItemData.Attributes,
  1762.        {$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, 1);
  1763. {$ENDIF}
  1764. end;
  1765.  
  1766. function TdfsSystemTreeView.AddNewNode(const ParentNode: TTreeNode;
  1767.    const NodeName: string; SelectNewNode: boolean): boolean;
  1768. var
  1769.   Dir: string;
  1770.   Temp: TTreeNode;
  1771. begin
  1772.   Result := FALSE;
  1773.   Dir := GetNodePath(ParentNode);
  1774.   if (Dir = '') or (NodeName = '') then exit; // only add to file system nodes.
  1775.  
  1776.   if Dir[Length(Dir)] <> '\' then
  1777.     Dir := Dir + '\';
  1778.   Dir := Dir + NodeName;
  1779.  
  1780. {$IFDEF DFS_STV_FILECHANGES}
  1781.   // Turn off the file change thread.
  1782.   Temp := NIL;
  1783.   if FCThread <> NIL then
  1784.   begin
  1785.     Temp := WatchedNode;
  1786.     WatchedNode:= NIL;
  1787.     FCThread.Terminate;
  1788.     FCThread := NIL;
  1789.   end;
  1790.   if ParentThread <> NIL then
  1791.   begin
  1792.     ParentWatchedNode := NIL;
  1793.     ParentThread.Terminate;
  1794.     ParentThread := NIL;
  1795.   end;
  1796. {$ENDIF}
  1797.  
  1798.   Result := CreateDirectory(PChar(Dir), NIL);
  1799.   if Result then
  1800.   begin
  1801.     ResetNode(ParentNode);
  1802.     if SelectNewNode then
  1803.     begin
  1804.       Temp := ParentNode.GetFirstChild;
  1805.       while assigned(Temp) do
  1806.       begin
  1807.         if Temp.Text = NodeName then
  1808.         begin
  1809.           Selected := Temp;
  1810.           break; // We're done
  1811.         end;
  1812.         Temp := Temp.GetNextSibling;
  1813.       end;
  1814. {$IFDEF DFS_STV_FILECHANGES}
  1815.       Temp := NIL; // Changing Selected will restart the watch.
  1816. {$ENDIF}
  1817.     end;
  1818.   end;
  1819.  
  1820. {$IFDEF DFS_STV_FILECHANGES}
  1821.   if Temp <> NIL then
  1822.     WatchDirectoryForChanges(Temp);
  1823. {$ENDIF}
  1824. end;
  1825.  
  1826. function TdfsSystemTreeView.GetVersion: string;
  1827. begin
  1828.   Result := DFS_COMPONENT_TREE_VERSION;
  1829. end;
  1830.  
  1831. procedure TdfsSystemTreeView.SetVersion(const Val: string);
  1832. begin
  1833.   { empty write method, just needed to get it to show up in Object Inspector }
  1834. end;
  1835.  
  1836. (*******************************************************************************
  1837.  Computes if tree must be moved up or down, left or right, depending on mouse
  1838.  position.
  1839. *******************************************************************************)
  1840. procedure TdfsSystemTreeView.Compute_TreeMoves(X, Y: integer);
  1841. var
  1842.   NbPixels: Integer;
  1843.   RMin, RMax: Integer;
  1844.   HOffset,
  1845.   VOffset: Integer;
  1846. begin
  1847.   // Comments by Aristide Torrelli
  1848.   {--------------------------------------------------------------------}
  1849.   { Algorithm :                                                        }
  1850.   { -----------                                                        }
  1851.   { . Detect scroll bars (horizontal and/or vertical) to set offsets   }
  1852.   { . If mouse is near upper edge or lower edge, scroll the control to }
  1853.   {   up or down by one line                                           }
  1854.   { . If mouse is near left or right edge, scroll the control to one   }
  1855.   {   page left or one page right                                      }
  1856.   {--------------------------------------------------------------------}
  1857.   if not FAutoscroll then exit;
  1858.   {--------------------------------------------------------------------}
  1859.   { Retrieve the scroll bar ranges, if such scroll bars exist (either  }
  1860.   { horizontal or vertical). An offset must be set if there is a       }
  1861.   { scroll bar, i-e if there is a range (RMin <> RMax).                }
  1862.   {--------------------------------------------------------------------}
  1863.   GetScrollRange(Handle, SB_HORZ, RMin, RMax);
  1864.   if RMin = RMax then
  1865.      HOffset := 0
  1866.   else
  1867.     HOffset := 16;
  1868.   GetScrollRange(Handle, SB_VERT, RMin, RMax);
  1869.   If RMin = RMax then
  1870.     VOffset := 0
  1871.   else
  1872.     VOffset := 16;
  1873.  
  1874.   {--------------------------------------------------------------------}
  1875.   { Near an edge means at a maximum of (half) a line, i-e half the     }
  1876.   { pixles of the current font.                                        }
  1877.   {--------------------------------------------------------------------}
  1878.   NbPixels := Abs((Font.Height));
  1879.  
  1880.   if (Y < NbPixels) then
  1881.     Perform(WM_VSCROLL, SB_LINEUP, 0)
  1882.   else if (Y > Height - VOffset - NbPixels) then
  1883.     Perform(WM_VSCROLL, SB_LINEDOWN, 0);
  1884.  
  1885.   if (X < NbPixels ) then
  1886.     Perform(WM_HSCROLL, SB_LINELEFT, 0)
  1887.   else if (X > Width - HOffset - NbPixels) then
  1888.     Perform(WM_HSCROLL, SB_LINERIGHT, 0);
  1889. end;
  1890.  
  1891. procedure TdfsSystemTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
  1892. begin
  1893.   if FAutoScroll then
  1894.     Compute_TreeMoves( X, Y );
  1895.   inherited MouseMove( Shift, X, Y );
  1896. end;
  1897.  
  1898. procedure TdfsSystemTreeView.Populated(Node: TTreeNode);
  1899. begin
  1900.   if assigned(FOnPopulated) then
  1901.     FOnPopulated(Self, Node);
  1902. end;
  1903.  
  1904. // Implementation must return the actual ID list.  Caller will make a copy
  1905. // of it it wants it's own.  Implementer owns this one, i.e. it's the "real
  1906. // thing".  If there isn't one, return NIL.
  1907. function TdfsSystemTreeView.GetSelectionPIDL: PItemIDList;
  1908. begin
  1909.   if (Selected <> NIL) and (Selected.Data <> NIL) then
  1910.     Result := NodeData[Selected].FQ_IDList
  1911.   else
  1912.     Result := NIL;
  1913. end;
  1914.  
  1915. function TdfsSystemTreeView.GetSelectionParentFolder: IShellFolder;
  1916. begin
  1917.   Result := FDesktopFolder;
  1918. (*
  1919.   if (Selected <> NIL) and (Selected.Data <> NIL) then
  1920.     Result := NodeData[Selected].SFParent
  1921.   else
  1922.     Result := NIL;
  1923. *)
  1924. end;
  1925.  
  1926. // Implementation notes: IDList parameter belongs to someone else.  If
  1927. // needed by this component, a copy must be made of it.  This differs from
  1928. // the Reset method in that it does not notify linked controls of a change
  1929. // because that could result in an endless cycle of notifications. Return
  1930. // value indicates success or failure.
  1931. function TdfsSystemTreeView.LinkedReset(const ParentFolder: IShellFolder;
  1932.    const IDList: PItemIDList; ForceUpdate: boolean): boolean;
  1933. var
  1934.   FindID: PItemIDList;
  1935. begin
  1936.  
  1937.   // This method is not intended for general purpose use.  It makes some
  1938.   // assumptions about what is being passed, and if those aren't valid then
  1939.   // it won't work (or worse).  Internal use only!
  1940.   Result := FALSE;
  1941.   //!!! May need to treat NIL IDList as a root selection.
  1942.   if (IDList <> NIL) then
  1943.   begin
  1944.     // Adjust for the lack of a "Desktop" node since FQ pidls do include it.
  1945.     if RootFolder in [rfFileSystem, rfDrives] then
  1946.       FindID := NextPIDL(IDList) // Move to the next ID in the list
  1947.     else
  1948.       FindID := IDList;
  1949.     Selected := FindNodeFromID(FindID);
  1950.     if Selected <> NIL then
  1951.       Selected.MakeVisible;
  1952.   end;
  1953.  
  1954. (* This is the old code for listview resets...
  1955.   Node := Selected;
  1956.   if (IDList <> NIL) and (Items.Count > 0) and (Node <> NIL) and
  1957.      (Node.Data <> NIL) then
  1958.   begin
  1959.     if not Node.Expanded then
  1960.       Node.Expand(FALSE);
  1961.     if TFolderItemData(Node.Data).IDList = IDList then exit;
  1962.     Node := Node.GetFirstChild;
  1963.     while Node <> NIL do
  1964.     begin
  1965.       if Node.Data <> NIL then
  1966.         if ComparePIDLs(TFolderItemData(Node.Data).IDList, IDList) then
  1967.         begin
  1968.           // Found it!
  1969.           Selected := Node;
  1970.           Result := TRUE;
  1971.           break;
  1972.         end;
  1973.       Node := Node.GetNextSibling;
  1974.     end;
  1975.   end;
  1976. *)
  1977. end;
  1978.  
  1979. {$IFDEF DFS_SCP_SYSCOMBOBOX}
  1980. procedure TdfsSystemTreeView.ComboBoxSetSelectionPIDL(APIDL: PItemIDList);
  1981. var
  1982.   HoldIDlist: TList;
  1983.   TempPIDL, FindID: PItemIDList;
  1984.   Node, ChildNode: TTreeNode;
  1985.   x: integer;
  1986. begin
  1987.   Node := Selected;
  1988.   if (APIDL <> NIL) and (Items.Count > 0) and (Node <> NIL) and
  1989.      (Node.Data <> NIL) then
  1990.   begin
  1991.     // take the PIDL passed and strip every ItemFrom it and add it to a list
  1992.     HoldIDList := TList.Create;
  1993.     try
  1994.       FindID := CopyPIDL(APIDL);
  1995.  
  1996.       while (FindID.mkid.cb <> 0) do
  1997.       begin
  1998.         //Add this id to the list
  1999.         HoldIDList.Add(CopyPidl(FindID));
  2000.         TempPIDL := CopyParentPIDL(FindID);
  2001.         FreePIDL(FindID);
  2002.         FindID := TempPIDL;
  2003.       end;
  2004.       HoldIDList.Add(FindID);
  2005.       //Now the last Item in the list should be the desktop.
  2006.       if ComparePIDLs(TFolderItemData(Items[0].Data).FQ_IDList,
  2007.                       PItemIDList(HoldIDlist.Items[HoldIDList.Count-1])) then
  2008.       begin
  2009.         // yup the last item is the desktop!
  2010.         Node:=Items[0];
  2011.         // now start expanding the tree until we find the item passed
  2012.         for x := HoldIDList.Count-2 downto 0 do
  2013.         begin
  2014.           Node.Expand(False);
  2015.           ChildNode := Node.GetFirstChild;
  2016.           while ChildNode <> NIL do
  2017.           begin
  2018.             if ChildNode.Data <> NIL then
  2019.               // change it to look at FUll id
  2020.               if ComparePIDLs(TFolderItemData(ChildNode.Data).FQ_IDList,
  2021.                  PItemIDList(HoldIDlist.Items[x])) then
  2022.               begin
  2023.                 // Found it!
  2024.                 Node := ChildNode;
  2025.                 break;
  2026.               end;
  2027.             ChildNode := ChildNode.GetNextSibling;
  2028.           end;
  2029.         end;
  2030.  
  2031.         Selected := Node;
  2032.         if not Node.Expanded then
  2033.           Node.Expand(False);
  2034.       end;
  2035.     finally
  2036.       for x := 0 to HoldIDList.Count-1 do
  2037.       begin
  2038.         TempPIDL := HoldIDList[x];
  2039.         FreePIDL(TempPIDL);
  2040.       end;
  2041.       HoldIDList.Free;
  2042.     end;
  2043.   end;
  2044. end;
  2045. {$ENDIF}
  2046.  
  2047.  
  2048.  
  2049. procedure TdfsSystemTreeView.ChangeToParent;
  2050. begin
  2051.   if Selected.Parent <> NIL then
  2052.   begin
  2053.     Selected := Selected.Parent;
  2054.     Selected.MakeVisible;
  2055.   end else
  2056.     MessageBeep(MB_ICONSTOP); // At root, stop that!
  2057. end;
  2058.  
  2059. initialization
  2060.   NewCount := 0;
  2061.  
  2062. finalization
  2063. {$IFDEF DFS_DEBUG} try {$ENDIF}
  2064.   // You might want to take this out for production releases.  I wanted to do
  2065.   // it with an {$IFDEF}, but the compiler is nasty about it
  2066. {  if NewCount > 0 then
  2067.     raise ELeaking.Create(MEMLEAK_STR);}
  2068. end.
  2069.  
  2070.  
  2071.  
  2072.