home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / SystemComboBox.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-28  |  44KB  |  1,162 lines
  1. {$I DFS.INC}                    { Defines for all Delphi Free Stuff components }
  2. {$I SYSTEMCONTROLPACK.INC}      { Defines specific to these components }
  3.  
  4. { -----------------------------------------------------------------------------}
  5. { TdfsSystemComboBox                                                           }
  6. { -----------------------------------------------------------------------------}
  7. { A combo box control that acts as the combo box in the Windows Explorer.      }
  8. { This is part of the System Control Pack.                                     }
  9. { Copyright 1999, Andrew Barnes and Brad Stowers.  All Rights Reserved.        }
  10. { -----------------------------------------------------------------------------}
  11. { NOTE:  This component was originally developed entirely by Andrew Barnes.    }
  12. {   Originally, I wanted to keep it as close to his originally code as         }
  13. {   possible, while still making it work with the tree/list view components.   }
  14. {   However, during this integration of the components, I found that it simply }
  15. {   wasn't going to work well that way.  After discussing this with Andrew,    }
  16. {   he agreed to let me "adopt" the code and modify it as needed in order to   }
  17. {   make it work well with the other components.  While I've made a lot of     }
  18. {   changes to this component, the core of it is still what Andrew developed   }
  19. {   and shared with us.  He deserves a huge amount of thanks for doing this,   }
  20. {   as it seemed I was never going to get to it myself.                        }
  21. { -----------------------------------------------------------------------------}
  22. {                                                                              }
  23. { Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
  24. {                                                                              }
  25. { Copyright:                                                                   }
  26. { All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
  27. { Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
  28. { property of the author.                                                      }
  29. {                                                                              }
  30. { Distribution Rights:                                                         }
  31. { You are granted a non-exlusive, royalty-free right to produce and distribute }
  32. { compiled binary files (executables, DLLs, etc.) that are built with any of   }
  33. { the DFS source code unless specifically stated otherwise.                    }
  34. { You are further granted permission to redistribute any of the DFS source     }
  35. { code in source code form, provided that the original archive as found on the }
  36. { DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
  37. { example, if you create a descendant of TDFSColorButton, you must include in  }
  38. { the distribution package the colorbtn.zip file in the exact form that you    }
  39. { downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
  40. {                                                                              }
  41. { Restrictions:                                                                }
  42. { Without the express written consent of the author, you may not:              }
  43. {   * Distribute modified versions of any DFS source code by itself. You must  }
  44. {     include the original archive as you found it at the DFS site.            }
  45. {   * Sell or lease any portion of DFS source code. You are, of course, free   }
  46. {     to sell any of your own original code that works with, enhances, etc.    }
  47. {     DFS source code.                                                         }
  48. {   * Distribute DFS source code for profit.                                   }
  49. {                                                                              }
  50. { Warranty:                                                                    }
  51. { There is absolutely no warranty of any kind whatsoever with any of the DFS   }
  52. { source code (hereafter "software"). The software is provided to you "AS-IS", }
  53. { and all risks and losses associated with it's use are assumed by you. In no  }
  54. { event shall the author of the softare, Bradley D. Stowers, be held           }
  55. { accountable for any damages or losses that may occur from use or misuse of   }
  56. { the software.                                                                }
  57. {                                                                              }
  58. { Support:                                                                     }
  59. { Support is provided via the DFS Support Forum, which is a web-based message  }
  60. { system.  You can find it at http://www.delphifreestuff.com/discus/           }
  61. { All DFS source code is provided free of charge. As such, I can not guarantee }
  62. { any support whatsoever. While I do try to answer all questions that I        }
  63. { receive, and address all problems that are reported to me, you must          }
  64. { understand that I simply can not guarantee that this will always be so.      }
  65. {                                                                              }
  66. { Clarifications:                                                              }
  67. { If you need any further information, please feel free to contact me directly.}
  68. { This agreement can be found online at my site in the "Miscellaneous" section.}
  69. {------------------------------------------------------------------------------}
  70. { The lateset version of my components are always available on the web at:     }
  71. {   http://www.delphifreestuff.com/                                            }
  72. { See SCP.txt for notes, known issues, and revision history.                   }
  73. { -----------------------------------------------------------------------------}
  74. { Date last modified:  June 28, 2001                                           }
  75. { -----------------------------------------------------------------------------}
  76.  
  77. unit SystemComboBox;
  78.  
  79. interface
  80.  
  81. {$IFNDEF DFS_SCP_SYSCOMBOBOX}
  82.   'Error, shouldn''t be compiling this unit!'
  83. {$ENDIF}
  84.  
  85. uses
  86.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  87.   {$IFDEF DFS_COMPILER_4_UP} ImgList, {$ENDIF}
  88.   {$IFDEF DFS_COMPILER_3_UP} ShlObj, ActiveX, {$ELSE} MyShlObj, OLE2, {$ENDIF}
  89.   StdCtrls, ComCtrls, SystemControlPack;
  90.  
  91. const
  92.   DFS_COMPONENT_COMBO_VERSION = 'TdfsSystemComboBox ' + DFS_SCP_VERSION;
  93.  
  94. type
  95.   TShellItem = class
  96.   public
  97.     ParentShellFolder,            // parent shell folder
  98.     ShellFolder: IShellFolder;    // shell folder for this shell item
  99.     FullID,                       // a fully qualified ID
  100.     ID: PItemIDList;              // ID releative to the parent shell folder
  101.     FullPathName,                 // a fully qualified path
  102.     RelativePathName: string;     // path relative to the parent
  103.     NormalIndex,                  // normal system image list index
  104.     SelectedIndex,                // selected system image list index
  105.     Indent: integer;              // indent for sub items
  106.     ParentItem: TShellItem;       // parent shellitem
  107.     Removeable: boolean;          // used to keep the default items in the list
  108.     ChildList: TList;             // list of child items, this could be removed
  109.                                   // with some code changes.
  110.     constructor Create; {$IFDEF DFS_COMPILER_4_UP} reintroduce; {$ENDIF}
  111.     destructor Destroy; override;
  112.     procedure AddChild(Item: TShellItem);
  113.   end;
  114.  
  115.   TdfsSystemComboBox = class(TdfsCustomSystemComboBox)
  116.   private
  117.     FDrawInEdit: boolean;          // boolean used for first item when dropped
  118.     FPIDL: PItemIDList;            // root(desktop) folder's ItemIDList
  119.     FDesktopFolder: IShellFolder;  // Shell folder used for the desktop
  120.     FDesktopShellItem: TShellItem; // The shell item associated with the desktop
  121.     FActiveFolderIDList: PItemIDList; // ActiveFolderIDList property decleration
  122.     FRecreatingWnd: boolean;
  123.  
  124.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  125.     procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM;
  126.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  127.  
  128.     function GetActiveFolderName: string;
  129.     procedure SetActiveFolderName(const Value: string);
  130.     procedure SetActiveFolderIDList(const Value: PItemIDList);
  131.     procedure EnumerateSubItems(const ParentShellItem: TShellItem;
  132.        const InsertIndex: integer; const CanDelete: boolean);
  133.     procedure AddShellItem(const ParentShellItem: TShellItem;
  134.        const NewID: PItemIDList; const CanDelete: boolean);
  135.     procedure AddSubItems(ShellItem: TShellItem);
  136.     procedure InsertSubItems(ShellItem: TShellItem; InsertIndex: integer);
  137.     procedure RemoveAllItems;
  138.     function GetActiveFolderIDList: PItemIDList;
  139.     function GetVersion: string;
  140.     procedure SetVersion(const Val: string);
  141.   protected
  142.     { Base Class Abstract Implementations }
  143.     // Implementation must return the actual ID list.  Caller will make a copy
  144.     // of it it wants it's own.  Implementer owns this one, i.e. it's the "real
  145.     // thing".  If there isn't one, return NIL.
  146.     function GetSelectionPIDL: PItemIDList; override;
  147.     function GetSelectionParentFolder: IShellFolder; override;
  148.     // Implementation notes: IDList parameter belongs to someone else.  If
  149.     // needed by this component, a copy must be made of it.  This differs from
  150.     // the Reset method in that it does not notify linked controls of a change
  151.     // because that could result in an endless cycle of notifications. Return
  152.     // value indicates success or failure.
  153.     function LinkedReset(const ParentFolder: IShellFolder;
  154.        const IDList: PItemIDList; ForceUpdate: boolean): boolean; override;
  155.     procedure PopulateCombo;
  156.     
  157.     procedure CreateWnd; override;
  158.     procedure DestroyWnd; override;
  159.     procedure Loaded; override;
  160.     procedure DrawItem(Index: integer; Rect: TRect;
  161.        State: TOwnerDrawState); override;
  162.   public
  163.     constructor Create(AOwner: TComponent); override;
  164.     destructor Destroy; override;
  165.     procedure Reset; override;
  166.     // Move up one directory, i.e. "cd .."
  167.     procedure ChangeToParent;
  168.  
  169.     // Can't publish this because it could be system dependent.
  170.     property ActiveFolderName: string
  171.        read GetActiveFolderName
  172.        write SetActiveFolderName;
  173.     property ActiveFolderIDList: PItemIDList
  174.        read GetActiveFolderIDList
  175.        write SetActiveFolderIDList;
  176.   published
  177.     {$IFDEF DFS_SCP_SYSTREEVIEW}
  178.     property TreeView;
  179.     {$ENDIF}
  180.     {$IFDEF DFS_SCP_SYSLISTVIEW}
  181.     property ListView;
  182.     {$ENDIF}
  183.     property Version: string
  184.        read GetVersion
  185.        write SetVersion
  186.        stored FALSE;
  187. //    property Style; -- It's always owner drawn, don't publish it.
  188.     property Align;
  189.     {$IFDEF DFS_COMPILER_4_UP}
  190.     property Anchors;
  191.     property BiDiMode;
  192.     {$ENDIF}
  193.     property Color;
  194.     {$IFDEF DFS_COMPILER_4_UP}
  195.     property Constraints;
  196.     {$ENDIF}
  197.     property Ctl3D;
  198.     property DragMode;
  199.     property DragCursor;
  200.     {$IFDEF DFS_COMPILER_4_UP}
  201.     property DragKind;
  202.     {$ENDIF}
  203.     property DropDownCount;
  204.     property Enabled;
  205.     property Font;
  206.     {$IFDEF DFS_COMPILER_3_UP}
  207.     property ImeMode;
  208.     property ImeName;
  209.     {$ENDIF}
  210.     property ItemHeight;
  211.     property MaxLength;
  212.     {$IFDEF DFS_COMPILER_4_UP}
  213.     property ParentBiDiMode;
  214.     {$ENDIF}
  215.     property ParentColor;
  216.     property ParentCtl3D;
  217.     property ParentFont;
  218.     property ParentShowHint;
  219.     property PopupMenu;
  220.     property ShowHint;
  221. //    property Sorted;  -- We sort it internally.
  222.     property TabOrder;
  223.     property TabStop;
  224. //    property Text;  -- not an editable combo, so makes no sense to publish.
  225.     property Visible;
  226.     property OnChange;
  227.     property OnClick;
  228.     property OnDblClick;
  229.     property OnDragDrop;
  230.     property OnDragOver;
  231.     property OnDrawItem;
  232.     property OnDropDown;
  233.     {$IFDEF DFS_COMPILER_4_UP}
  234.     property OnEndDock;
  235.     {$ENDIF}
  236.     property OnEndDrag;
  237.     property OnEnter;
  238.     property OnExit;
  239.     property OnKeyDown;
  240.     property OnKeyPress;
  241.     property OnKeyUp;
  242.     property OnMeasureItem;
  243.     {$IFDEF DFS_COMPILER_4_UP}
  244.     property OnStartDock;
  245.     {$ENDIF}
  246.     property OnStartDrag;
  247.   end;
  248.  
  249. implementation
  250.  
  251. uses
  252.   PidlHelp, CommCtrl,
  253.   {$IFDEF DFS_DEBUG} uDbg, {$ENDIF}
  254.   {$IFDEF DFS_COMPILER_3_UP} ComObj, {$ELSE} OleAuto, {$ENDIF}
  255.   ShellAPI;
  256.  
  257.  
  258. {*******************************************************************************
  259. function:     GetShellImage
  260. Parameters:   PIDL        PItemIDList
  261.               Large       Boolean
  262.               Open        Boolean
  263. Result:       Integer
  264. Notes:
  265.   This function returns the index of PIDL in the system image list.
  266.   If Large is open, it returns the Large image index.
  267.   If Open is true, it returns the Open image index.
  268.  
  269. Revision History
  270. yyyy/mm/dd        By: change
  271. 1999/02/07        andrew@vemco.com: Initial from VirtualListViewDemo
  272. *******************************************************************************}
  273. function GetShellImage(PIDL: PItemIDList; Large, Open: Boolean): Integer;
  274. var
  275.   FileInfo: TSHFileInfo;
  276.   Flags: Integer;
  277. begin
  278.   FillChar(FileInfo, SizeOf(FileInfo), #0);
  279.   Flags := SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_ICON;
  280.   if Open then
  281.     Flags := Flags or SHGFI_OPENICON;
  282.   if Large then
  283.     Flags := Flags or SHGFI_LARGEICON
  284.   else
  285.     Flags := Flags or SHGFI_SMALLICON;
  286.   SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(FileInfo), Flags);
  287.   Result := FileInfo.iIcon;
  288. end;
  289.  
  290. {*******************************************************************************
  291. function:     SortChildren
  292. Parameters:   Item1, Item2 Pointer
  293. Result:       Integer
  294. Notes:
  295.   This function is the sort algorithum used for sorting child items.
  296.   This is requured by the Tlist's sort method.  Sort implementation
  297.   was taken from SystemTreeViews sort of child nodes but modified for my
  298.   component.
  299.  
  300.   Origional source by Brad Stowers
  301.  
  302. Revision History
  303. yyyy/mm/dd        By: change
  304. 1999/02/07        andrew@vemco.com: Initial from SystemTreeView
  305. *******************************************************************************}
  306. function SortChildren(Item1, Item2: Pointer): Integer;
  307. begin
  308.   if Item1 = Item2 then
  309.     Result := 0
  310.   else if Item1 = NIL then
  311.     Result := -1
  312.   else if Item2 = NIL then
  313.     Result := 1
  314.   else begin
  315.     // Status is returned in the 'code' portion (low word) of the result.
  316.     // Search for 'HResult' in Winodws.pas to read more about it.
  317.     // 0 means sort by name.
  318.     Result := shortint(TShellItem(Item1).ParentShellFolder.CompareIDs(0,
  319.        TShellItem(Item1).ID, TShellItem(Item2).ID));
  320.   end;
  321. end;
  322.  
  323. { TShellItem }
  324.  
  325. {*******************************************************************************
  326. constructor  TShellItem.Create
  327. Parameters None
  328. Notes:
  329.   This proceudre allocates a child list for the shell item
  330. Revision History
  331. yyyy/mm/dd        By: change
  332. 1999/02/07        andrew@vemco.com: Initial
  333. *******************************************************************************}
  334. constructor TShellItem.Create;
  335. begin
  336.   inherited Create;
  337.  
  338.   ChildList := TList.Create;
  339. end;
  340.  
  341. {*******************************************************************************
  342. Destructor  TShellItem.Destroy
  343. Parameters None
  344. Notes:
  345.   This proceudre frees the dynamic memory used by this ShellItem
  346. Revision History
  347. yyyy/mm/dd        By: change
  348. 1999/02/07        andrew@vemco.com: Initial
  349. 1999/02/15        bstowers@pobox.com: D2/C1 compatibility, plugged memory leak.
  350. *******************************************************************************}
  351. destructor TShellItem.Destroy;
  352. var
  353.   Same: boolean;
  354. begin
  355.   {$IFNDEF DFS_NO_COM_CLEANUP}
  356.   if ParentShellFolder <> NIL then
  357.     ParentShellFolder.Release;
  358.   if ShellFolder <> NIL then
  359.     ShellFolder.Release;
  360.   {$ENDIF}
  361.   Same := ComparePIDLs(ID, FullID);
  362.   FreePIDL(ID);
  363.   if not Same then
  364.     FreePIDL(FullID);
  365.   ChildList.Free;
  366.  
  367.   inherited Destroy;
  368. end;
  369.  
  370. {*******************************************************************************
  371. procedure  TShellItem.AddChild
  372. Parameters Item  TShellItem
  373. Notes:
  374.   This proceudre adds a child item to the list oc child items for this
  375.   Shell item
  376. Revision History
  377. yyyy/mm/dd        By: change
  378. 1999/02/07        andrew@vemco.com: Initial
  379. *******************************************************************************}
  380. procedure TShellItem.AddChild(Item: TShellItem);
  381. begin
  382.   ChildList.Add(Item);
  383.   ChildList.Sort(SortChildren);
  384. end;
  385.  
  386.  
  387. { TdfsSystemComboBox }
  388.  
  389. {*******************************************************************************
  390. Constructor:  TdfsSystemComboBox.Create
  391. Parameters:   AOwner  TComponent
  392. Notes:
  393.   This constructor is based on the constructor for the SysTreeView component.
  394.   Gets access to the system image list and sets the initializes the comobox
  395.   style.
  396.  
  397. Revision History
  398. yyyy/mm/dd        By: change
  399. 1999/02/07        andrew@vemco.com: Initial from SystemTreeView
  400. 1999/02/15        bstowers@pobox.com: Moved image list stuff into SetupImageList
  401.                                       in base class.
  402. *******************************************************************************}
  403. constructor TdfsSystemComboBox.Create(AOwner: TComponent);
  404. begin
  405.   inherited Create(AOwner);
  406.  
  407.   Style := csOwnerDrawFixed;
  408. end;
  409.  
  410. {*******************************************************************************
  411. Destructor:   TdfsSystemComboBox.Destroy
  412. Parameters:
  413. Notes:
  414.   Clean up allocations
  415.  
  416. Revision History
  417. yyyy/mm/dd        By: change
  418. 1999/02/07        andrew@vemco.com: Initial
  419. 1999/02/15        bstowers@pobox.com: D2/C1 compatibility, plugged pidl leak.
  420. *******************************************************************************}
  421. destructor TdfsSystemComboBox.Destroy;
  422. begin
  423.   // Easiest way to free the associated objects
  424. {  while Items.Count > 0 do
  425.     Items.Delete(Items.Count - 1);}
  426.     
  427.   { FDesktopShellItem, FDesktopFolder and FPIDL are in the Objects property, so
  428.     they will be released when all the rest of the items are delete.  We don't
  429.     need to do it here.  Only FActiveFolderIDList is "unowned". }
  430.   FreePIDL(FActiveFolderIDList);
  431.  
  432.   inherited Destroy;
  433. end;
  434.  
  435. procedure TdfsSystemComboBox.PopulateCombo;
  436. var
  437.   ShellItem: TShellItem;
  438.   InsertIndex, x: integer;
  439.   MyComputerPIDL: PItemIDList;
  440.   NoPIDL: PItemIDList;
  441.   Attrs: DWORD;
  442. begin
  443.   if (not HandleAllocated) or (csLoading in ComponentState) then
  444.     exit;
  445.  
  446. {$IFDEF DFS_DEBUG} Debugger.EnterProc('SCB.Reset'); {$ENDIF}
  447.  
  448.   // remove all items from the the list
  449.   RemoveAllItems;
  450.   // get the desktop shell folder
  451.   SHGetDesktopFolder(FDesktopFolder);
  452.   {$IFNDEF DFS_NO_COM_CLEANUP} FDesktopFolder.AddRef; {$ENDIF}
  453.  
  454.   // Invalidate cached information.
  455.   NoPIDL := NIL;
  456.   Attrs := SFGAO_VALIDATE;
  457.   FDesktopFolder.GetAttributesOf(0, NoPIDL, Attrs);
  458.  
  459.   OLECheck(SHGetSpecialFolderLocation(GetValidHandle, CSIDL_DESKTOP, FPIDL));
  460.  
  461.   // add the desktop shell item
  462.   FDesktopShellItem := TShellItem.Create;
  463.   FDesktopShellItem.ID := FPIDL;
  464.   FDesktopShellItem.FullID := FPIDL;
  465.   FDesktopShellItem.NormalIndex := GetShellImage(FPIDL, TRUE, FALSE);
  466.   FDesktopShellItem.SelectedIndex := GetShellImage(FPIDL, FALSE, TRUE);
  467.   FDesktopShellItem.FullPathName := GetDisplayName(FDesktopFolder, FPIDL,
  468.      dntForParsing);
  469.   FDeskTopShellItem.RelativePathName := GetDisplayName(FDesktopFolder, FPIDL,
  470.      dntNormal);
  471.   FDesktopShellItem.Indent := 0;
  472.   FDesktopShellItem.ParentShellFolder := NIL;
  473.   FDesktopShellItem.ShellFolder := FDesktopFolder;
  474.   {$IFNDEF DFS_NO_COM_CLEANUP} FDesktopShellItem.ShellFolder.AddRef; {$ENDIF}
  475.   FDesktopShellItem.Removeable := FALSE;
  476.   Items.AddObject(FDesktopShellItem.RelativePathName, FDesktopShellItem);
  477.  
  478.   // now add the sub items
  479.   EnumerateSubItems(FDesktopShellItem, 0, FALSE);
  480.   AddSubItems(FDesktopShellItem);
  481.  
  482.   // now find and populate the 'My Computer' node.
  483.   InsertIndex := 0;
  484.   ShellItem := NIL;
  485.   SHGetSpecialFolderLocation(GetValidHandle, CSIDL_DRIVES, MyComputerPIDL);
  486.   try
  487.     for x := 0 to Items.Count-1 do
  488.     begin
  489.       if ComparePIDLs(TShellItem(Items.Objects[x]).FullID, MyComputerPIDL) then
  490.       begin
  491.         ShellItem := TShellItem(Items.Objects[x]);
  492.         InsertIndex := x;
  493.         break;
  494.       end;
  495.     end;
  496.   finally
  497.     FreePIDL(MyComputerPIDL);
  498.   end;
  499.  
  500.   if ShellItem <> NIL then
  501.   begin
  502.     EnumerateSubItems(ShellItem, InsertIndex, FALSE);
  503.     InsertSubItems(ShellItem, InsertIndex);
  504.   end;
  505. end;
  506.  
  507. {*******************************************************************************
  508. Procedure:  TdfsSystemComboBox.Reset
  509. Parameters:
  510. Notes:
  511.   This proceudre overrides the default reset, removing all items, and reseting
  512.   to the default items. Selected is set to the desktop after rest.
  513.  
  514. Revision History
  515. yyyy/mm/dd        By: change
  516. 1999/02/07        andrew@vemco.com: Initial
  517. 1999/02/15        bstowers@pobox.com: D2/C1 compatibility.
  518.                                       Plugged pidl leak.
  519.                                       Fixed hard-coded "My Computer" reference.
  520.                                       Fixed compiler warning about uninit var.
  521.                                       PidlHelp unit changes.
  522. *******************************************************************************}
  523. procedure TdfsSystemComboBox.Reset;
  524. begin
  525. {$IFDEF DFS_DEBUG} Debugger.EnterProc('SCB.Reset'); {$ENDIF}
  526.  
  527.   PopulateCombo;
  528.   ItemIndex := 0;
  529.   inherited Reset;
  530.  
  531. {$IFDEF DFS_DEBUG} Debugger.LeaveProc('SCB.Reset'); {$ENDIF}
  532.  
  533. end;
  534.  
  535. {*******************************************************************************
  536. Procedure:  TdfsSystemComboBox.AddSubItems
  537. Parameters: ShellItem   TShellItem
  538. Notes:
  539.   This proceudre adds the sub items of the shellfoler pointed to by the
  540.   ShellFolder property of the passed parameter ShellItem to the list of items.
  541.   Items are added to the end of the list.  The items are assumed to be in the
  542.   ChildList of ShellItem.
  543.  
  544. Revision History
  545. yyyy/mm/dd        By: change
  546. 1999/02/07        andrew@vemco.com: Initial
  547. *******************************************************************************}
  548. procedure TdfsSystemComboBox.AddSubItems(ShellItem: TShellItem);
  549. var
  550.   x: integer;
  551.   NewShellItem: TShellItem;
  552. begin
  553.   for x := 0 to ShellItem.ChildList.Count-1  do
  554.   begin
  555.     NewShellItem := TShellItem(ShellItem.ChildList.Items[x]);
  556.     Items.AddObject(NewShellItem.RelativePathName, NewShellItem);
  557.   end;
  558. end;
  559.  
  560. {*******************************************************************************
  561. Procedure:  TdfsSystemComboBox.InsertSubItems
  562. Parameters: ShellItem   TShellItem
  563.             InserIndex  Integer
  564. Notes:
  565.   This proceudre adds the sub items of the shellfoler pointed to by the
  566.   ShellFolder property of the passed parameter ShellItem to the list of items.
  567.   Items are added after InsertIndex.  The items are assumed to be in the
  568.   ChildList of ShellItem.
  569.  
  570. Revision History
  571. yyyy/mm/dd        By: change
  572. 1999/02/07        andrew@vemco.com: Initial
  573. *******************************************************************************}
  574. procedure TdfsSystemComboBox.InsertSubItems(ShellItem: TShellItem;
  575.    InsertIndex: integer);
  576. var
  577.   x: integer;
  578.   NewShellItem: TShellItem;
  579. begin
  580.   for x := ShellItem.ChildList.Count-1 downto 0 do
  581.   begin
  582.     NewShellItem := TShellItem(ShellItem.ChildList.Items[x]);
  583.     Items.InsertObject(InsertIndex+1, NewShellItem.RelativePathName,
  584.        NewShellItem);
  585.   end;
  586. end;
  587.  
  588. {*******************************************************************************
  589. Procedure:  TdfsSystemComboBox.EnumerateSubItems
  590. Parameters: ParentShellItem   TShellItem
  591.             InserIndex  Integer
  592.             CanDelete    Boolean
  593. Notes:
  594.   This proceudre enumerates sub items of the shellfoler pointed to by the
  595.   ShellFolder property of the passed parameter ParentShellItem to the ChildList
  596.   of ParentShellItem.
  597.  
  598.   CanDelete is passed to set the Removeable property of the sub items added.
  599. Revision History
  600. yyyy/mm/dd        By: change
  601. 1999/02/07        andrew@vemco.com: Initial
  602. 1999/02/15        bstowers@pobox.com: D2/C1 compatibility, made a little more
  603.                                       robust.
  604. *******************************************************************************}
  605. procedure TdfsSystemComboBox.EnumerateSubItems(const ParentShellItem: TShellItem;
  606.    const InsertIndex: integer; const CanDelete: boolean);
  607. const
  608.   FLAGS = SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
  609. var
  610.   NewID: PItemIDList;
  611.   NumIDs: ULONG;
  612.   EnumList: IEnumIDList;
  613. begin
  614.   if Succeeded(ParentShellItem.ShellFolder.EnumObjects(GetValidHandle, FLAGS,
  615.      EnumList)) then
  616.   begin
  617.     while EnumList.Next(1, NewID, NumIDs) = S_OK do
  618.     begin
  619.       AddShellItem(ParentShellItem, NewID, CanDelete);
  620. // Could make a little more efficient by changing AddShellItem to use this ID instead of copying it and freeing it here.
  621.       FreePIDL(NewID);
  622.     end;
  623.     {$IFNDEF DFS_NO_COM_CLEANUP} EnumList.Release; {$ENDIF}
  624.   end;
  625. end;
  626.  
  627. {*******************************************************************************
  628. Procedure:  TdfsSystemComboBox.AddShellItem
  629. Parameters: ParentShellItem   TShellItem
  630.             NewID             PItemIDList
  631.             CanDelete         Boolean
  632. Notes:
  633.   This proceudre adds the shell item specified by NewID of the shellfoler
  634.   pointed to by the ShellFolder property of the passed parameter ParentShellItem
  635.   to ParentShellItem's list of child items.
  636.  
  637.   CanDelete is used to set the removeable property of the new item.
  638.  
  639. Revision History
  640. yyyy/mm/dd        By: change
  641. 1999/02/07        andrew@vemco.com: Initial
  642. 1999/02/15        bstowers@pobox.com: D2/C1 compatibility
  643.                                       Binding to wrong pidl
  644.                                       Removed unused variable
  645. *******************************************************************************}
  646. procedure TdfsSystemComboBox.AddShellItem(const ParentShellItem: TShellItem;
  647.    const NewID: PItemIDList; Const CanDelete: boolean);
  648. var
  649.   ShellItem: TShellItem;
  650.   NoPIDL: PItemIDList;
  651.   Attrs: DWORD;
  652. begin
  653.   ShellItem := TShellItem.Create;
  654.   with ShellItem do
  655.   begin
  656.     ParentItem := ParentShellItem;
  657.     ParentShellFolder := ParentItem.ShellFolder;
  658.     // Invalidate cached information.
  659.     NoPIDL := NIL;
  660.     Attrs := SFGAO_VALIDATE;
  661.     ParentShellFolder.GetAttributesOf(0, NoPIDL, Attrs);
  662.     {$IFNDEF DFS_NO_COM_CLEANUP} ParentShellFolder.AddRef; {$ENDIF}
  663. // See comments in EnumerateSubItems about copying this
  664.     ID := CopyPIDL(NewID);
  665.     ParentShellFolder.BindToObject(ID, NIL, IID_IShellFolder,
  666.        Pointer(ShellFolder));
  667.     {$IFNDEF DFS_NO_COM_CLEANUP}
  668.     if ShellFolder <> NIL then
  669.       ShellFolder.AddRef;
  670.     {$ENDIF}
  671.     FullID := ConcatPIDLs(ParentItem.FullID, ID);
  672.     NormalIndex := GetShellImage(FullID, TRUE, FALSE);
  673.     SelectedIndex := GetShellImage(FullID, TRUE, TRUE);
  674.     FullPathName := GetDisplayName(ParentItem.ShellFolder, ID, dntForParsing);
  675.     RelativePathName := GetDisplayName(ParentItem.ShellFolder, ID, dntNormal);
  676.     Indent := ShellItem.ParentItem.Indent+10;
  677.     Removeable := CanDelete;
  678.   end;
  679.   ParentShellItem.AddChild(ShellItem);
  680. end;
  681.  
  682. {*******************************************************************************
  683. Procedure:  TdfsSystemComboBox.DrawItem
  684. Parameters: Index   Integer
  685.             Rect    TRect
  686. Notes:
  687.   This proceudre draws the item specified by Index. It's kinda funky.  If the
  688.   drawing in the edit portion of the combo box draw without an indent.
  689.  
  690. Revision History
  691. yyyy/mm/dd        By: change
  692. 1999/02/07        andrew@vemco.com: Initial
  693. 1999/02/15        bstowers@pobox.com: Changed so that image and text are drawn
  694.                                       centered vertically in the given rect.
  695. *******************************************************************************}
  696. procedure TdfsSystemComboBox.DrawItem(Index: Integer; Rect: TRect;
  697.   State: TOwnerDrawState);
  698. var
  699.   BlueRect: TRect;
  700.   ShellItem: TShellItem;
  701. begin
  702.   if FDrawInEdit then
  703.   begin
  704.     if Index >= 0 then
  705.     begin
  706.       ShellItem := TShellItem(Items.Objects[Index]);
  707.       Images.DrawingStyle := dsTransparent;
  708.       Images.Draw(Canvas, Rect.Left + 2, Rect.Top + ((Rect.Bottom - Rect.Top -
  709.          Images.Height) div 2), ShellItem.SelectedIndex);
  710.       inc(Rect.Left, Images.Width + 6);
  711.       DrawText(Canvas.Handle, PChar(Items[Index]), -1, Rect, DT_LEFT or
  712.          DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER);
  713.     end else begin
  714.       Canvas.FillRect(rect);
  715.     end;
  716.   end else begin
  717.     if odSelected in State then
  718.     begin
  719.       Images.DrawingStyle := dsFocus;
  720.       Canvas.Brush.Color := clHighlight;
  721.       Canvas.Font.Color := clHighlightText;
  722.     end else
  723.       Images.DrawingStyle := dsTransparent;
  724.     with Canvas do
  725.     begin
  726.       ShellItem := TShellItem(Items.Objects[Index]);
  727.       BlueRect.Left := Rect.Left + Images.Width + 6 + ShellItem.Indent - 1;
  728.       BlueRect.Right := BlueRect.Left + Canvas.TextWidth(Items[Index]) + 2;
  729.       BlueRect.Top := Rect.Top;
  730.       BlueRect.Bottom := Rect.Bottom;
  731.       FillRect(BlueRect);
  732.       Inc(Rect.Left, ShellItem.Indent);
  733.       if Index = ItemIndex then
  734.         Images.Draw(Canvas, Rect.Left + 2, Rect.Top + ((Rect.Bottom-Rect.Top-
  735.            Images.Height) div 2), ShellItem.SelectedIndex)
  736.       else
  737.         Images.Draw(Canvas, Rect.Left + 2, Rect.Top + ((Rect.Bottom-Rect.Top-
  738.            Images.Height) div 2), ShellItem.NormalIndex);
  739.       inc(Rect.Left, Images.Width + 6);
  740.       DrawText(Handle, PChar(Items[Index]), -1, Rect, DT_LEFT or DT_NOPREFIX or
  741.          DT_SINGLELINE or DT_VCENTER);
  742.       if odFocused in State then
  743.          DrawFocusRect(BlueRect);
  744.     end;
  745.   end;
  746. end;
  747.  
  748. {*******************************************************************************
  749. Procedure:  TdfsSystemComboBox.CNDrawItem
  750. Parameters: Index   Integer
  751.             Rect    TRect
  752. Notes:
  753.   This procedure Overrides the default CNDrawItem method so the focus rect
  754.   and highlight are like explorer's.
  755.   It masks off the ItemState to determine where the item is being drawn.
  756.  
  757. Revision History
  758. yyyy/mm/dd        By: change
  759. 1999/02/07        andrew@vemco.com: Initial
  760. *******************************************************************************}
  761. procedure TdfsSystemComboBox.CNDrawItem(var Message: TWMDrawItem);
  762. var
  763.   State: TOwnerDrawState;
  764. begin
  765.   with Message.DrawItemStruct^ do
  766.   begin
  767.     // check and see if we are in the edit portion of the combo box
  768.     FDrawInEdit := (ODS_COMBOBOXEDIT and itemState) <> 0;
  769.     {$IFDEF DFS_COMPILER_5_UP}
  770.     State := TOwnerDrawState(LongRec(itemState).Lo);
  771.     {$ELSE}
  772.     State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  773.     {$ENDIF}
  774.     Canvas.Handle := hDC;
  775.     try
  776.       Canvas.Font := Font;
  777.       Canvas.Brush := Brush;
  778.       if Integer(itemID) >= 0 then
  779.         DrawItem(itemID, rcItem, State)
  780.       else
  781.         Canvas.FillRect(rcItem);
  782.     finally
  783.       Canvas.Handle := 0;
  784.     end;
  785.   end;
  786. end;
  787.  
  788. {*******************************************************************************
  789. Procedure:  TdfsSystemComboBox.SetActiveFolderName
  790. Parameters: Value String
  791. Notes:
  792.   This proceudre sets the active folder ( in the edit portion) based on the
  793.   passed string.  It is assumed that the string is a valid path somewere in
  794.   the file system, if not the active folder does not change.
  795.  
  796.   It gets the PIDL of the given string and then passes it to the
  797.   SetActiveFolderIDList method.
  798.  
  799. Revision History
  800. yyyy/mm/dd        By: change
  801. 1999/02/07        andrew@vemco.com: Initial
  802. 1999/02/07        bstowers@pobox.com: PidlHelp unit change
  803. *******************************************************************************}
  804. procedure TdfsSystemComboBox.SetActiveFolderName(const Value: String);
  805. var
  806.    FindID: PItemIDList;
  807. begin
  808.    if (FDesktopFolder <> NIL) and GetPIDLFromPath(GetValidHandle,
  809.       FDesktopFolder, Value, FindID) then
  810.      SetActiveFolderIDList(FindID);
  811. end;
  812.  
  813. {*******************************************************************************
  814. Procedure:  TdfsSystemComboBox.SetActiveFolderIDList
  815. Parameters: Value PItemIDList
  816. Notes:
  817.   This proceudre sets the active folder ( in the edit portion) based on the
  818.   passed PItemIDList.  It is assumed that is is a valid identifier somewere in
  819.   the file system, if not the active folder does not change.
  820.  
  821.   Remove any Items which are removeable. (added last time by this method)
  822.  
  823.   While the given ItemIDlist is in the default set of
  824.   Item Identifiers, strip the last one and add it to a list.
  825.  
  826.   At some point the item must exist or it was an invalid ItemIDList
  827.  
  828.   If it exists, add the items recursively.  THis will give the TreeView look.
  829. Revision History
  830. yyyy/mm/dd        By: change
  831. 1999/02/07        andrew@vemco.com: Initial
  832. 1999/02/15        bstowers@pobox.com: PidlHelp unit change.
  833.                                       Plugged several pidl leaks.
  834. *******************************************************************************}
  835. procedure TdfsSystemComboBox.SetActiveFolderIDList(const Value: PItemIDList);
  836.  
  837.    function InItems(ID: PItemIDList; var ValIndex: integer): boolean;
  838.    var
  839.      i: integer;
  840.      ShellItem: TShellItem;
  841.    begin
  842.      Result := FALSE;
  843.      for i := 0 to Items.Count-1 do
  844.      begin
  845.         ShellItem := TShellItem(Items.Objects[i]);
  846.         if FDesktopFolder.CompareIDs(0, ShellItem.FullID, ID) = 0 then
  847.         begin
  848.           ValIndex := i;
  849.           Result := TRUE;
  850.           break;
  851.         end;
  852.      end;
  853.    end;
  854.  
  855. var
  856.   TempPIDL,
  857.   FindID: PItemIDList;
  858.   IDList: TList;
  859.   x: integer;
  860.   Found: boolean;
  861.   InsertIndex: integer;
  862.   SelectedIndex: integer;
  863.   ShellItem: TShellItem;
  864. begin
  865. //!!! May need to treat this as a root selection.
  866.   if Value = NIL then
  867.     exit;
  868.  
  869.   // remove the items added last time
  870.   for x := Items.Count-1 downto 0 do
  871.   begin
  872.     ShellItem := TShellItem(Items.Objects[x]);
  873.     if Shellitem.Removeable then
  874.     begin
  875.       // remove the item from the parent list of child items.
  876.       with ShellItem.ParentItem.ChildList do
  877.         Delete(IndexOf(ShellItem));
  878.       Items.Delete(x); // This will free ShellItem in the WM_DELETEITEM handler
  879.     end;
  880.   end;
  881.  
  882.   Found := TRUE;
  883.   IDList := TList.Create;
  884.   FindID := CopyPIDL(Value);
  885.   try
  886.     { Now iterate through the PIDL and find the ItemIDList's parent item.
  887.       It must exist in the system or the ItemIDList passed is invalid}
  888.     while (not InItems(FindID, InsertIndex)) do
  889.     begin
  890.       { this item is not in our current tree. Add it to the list because we
  891.         will need it if we find the parent item}
  892.       IDList.Add(CopyLastID(FindID));
  893.       { Now see if it's parent exists }
  894.       TempPIDL := CopyParentPIDL(FindID);
  895.       try
  896.         FreePIDL(FindID);
  897.       finally
  898.         FindID := TempPIDL;
  899.      end;
  900.       if FindID.mkid.cb = 0 then
  901.       begin
  902.         Found := FALSE;
  903.         break;
  904.       end;
  905.     end;
  906.   finally
  907.     FreePIDL(FindID);
  908.   end;
  909.  
  910.   if Found then
  911.   begin
  912.     // now add the sub items to the list
  913.     SelectedIndex := InsertIndex+IdList.COunt;
  914.     for x := IDList.Count-1 downto 0 do
  915.     begin
  916.       ShellItem := TShellItem(Items.Objects[InsertIndex]);
  917.       AddShellItem(ShellItem, IDList.Items[x], TRUE);
  918.       InsertSubItems(ShellItem, InsertIndex);
  919.       Inc(InsertIndex);
  920.     end;
  921.     ItemIndex := SelectedIndex;
  922.     FreePIDL(FActiveFolderIDList);
  923.     FActiveFolderIDList := Value;
  924.   end else begin
  925.     TempPIDL := Value;
  926.     FreePIDL(TempPIDL);
  927.     ItemIndex := -1;
  928.   end;
  929.  
  930.   // now free the IDlist data
  931.   while IDList.Count <> 0 do
  932.   begin
  933.     TempPIDL := PItemIDList(IDlist.Items[0]);
  934.     FreePIDL(TempPIDL);
  935.     IdList.Delete(0);
  936.   end;
  937.   IDList.Free;
  938.  
  939.   NotifyLinkedControls(FALSE);
  940. end;
  941.  
  942. {*******************************************************************************
  943. Function:  TdfsSystemComboBox.GetActiveFolderName
  944. Result:    String
  945. Notes:
  946.   This proceudre returns the mame of the active folder
  947. Revision History
  948. yyyy/mm/dd        By: change
  949. 1999/02/07        andrew@vemco.com: Initial
  950. 1999/02/15        bstowers@pobox.com: Removed unnecessary variable.
  951. *******************************************************************************}
  952. function TdfsSystemComboBox.GetActiveFolderName: string;
  953. begin
  954.   Result := TShellItem(Items.Objects[ItemIndex]).FullPathName;
  955. end;
  956.  
  957. {*******************************************************************************
  958. Function:  TdfsSystemComboBox.RemoveAllItems
  959. Notes:
  960.   Removes all items in the list, and indirectly all data associated with those
  961.   items via WM_DELETEITEM message generated from here.
  962. Revision History
  963. yyyy/mm/dd        By: change
  964. 1999/02/07        andrew@vemco.com: Initial
  965. 1999/02/15        bstowers@pobox.com: Removed unnecessary variable.
  966. *******************************************************************************}
  967. procedure TdfsSystemComboBox.RemoveAllItems;
  968. var
  969.   x: integer;
  970. begin
  971.   // remove all the Items in the list
  972.   if Items.Count > 0 then
  973.   begin
  974.     for x := Items.Count -1 downto 0 do
  975.       Items.Delete(x); // This will free ShellItem in the WM_DELETEITEM handler.
  976.   end;
  977. end;
  978.  
  979. {*******************************************************************************
  980. Procedure:    TdfsSystemComboBox.Loaded
  981. Parameters:   AOwner  TComponent
  982. Notes:
  983.   Overrides the default Loaded procedure and reads the default items in to the
  984.   combo box.
  985.  
  986. Revision History
  987. yyyy/mm/dd        By: change
  988. 1999/02/07        andrew@vemco.com: Initial from SystemTreeView
  989. 1999/02/15        bstowers@pobox.com: Removed ItemIndex assignment, done in Reset
  990. *******************************************************************************}
  991. procedure TdfsSystemComboBox.Loaded;
  992. begin
  993.   inherited Loaded;
  994.  
  995.   Reset; // We've finished loading, we can populate the tree now.
  996. end;
  997.  
  998. {*******************************************************************************
  999. procedure  TdfsSystemComboBox.CreateWnd
  1000. Parameters var Message: TWMDeleteItem
  1001. Notes:
  1002.   This proceudre overrides the default CreateWnd method.  It was overridden
  1003.   so that the combo box will be populated and the default ItemIndex is 0
  1004. Revision History
  1005. yyyy/mm/dd        By: change
  1006. 1999/02/07        andrew@vemco.com: Initial
  1007. 1999/02/15        bstowers@pobox.com: Removed ItemIndex assignment, done in Reset
  1008.                                       Added some comments for clarification.
  1009. *******************************************************************************}
  1010. procedure TdfsSystemComboBox.CreateWnd;
  1011. begin
  1012.   inherited CreateWnd;
  1013.  
  1014.   FRecreatingWnd := FALSE;
  1015.   // If we are loading object from stream (form file), we have to wait until
  1016.   // everything is loaded before populating the list.  If we are not loading,
  1017.   // i.e. the component was created dynamically or was just dropped on a form,
  1018.   // we need to populate it now since the Loaded method will never get called.
  1019.   // Reset handles this internally.
  1020.   Reset;
  1021. end;
  1022.  
  1023. procedure TdfsSystemComboBox.DestroyWnd;
  1024. begin
  1025.   FRecreatingWnd := TRUE;
  1026.   inherited;
  1027. end;
  1028.  
  1029. {*******************************************************************************
  1030. procedure  TdfsSystemComboBox.WMDeleteItem
  1031. Parameters var Message: TWMDeleteItem
  1032. Notes:
  1033.   This proceudre overrides the default WMDeteteItem method.  It was overridden
  1034.   so that the ShellItem associated with this ComboBox item is free.
  1035. Revision History
  1036. yyyy/mm/dd        By: change
  1037. 1999/02/07        andrew@vemco.com: Initial
  1038. *******************************************************************************}
  1039. procedure TdfsSystemComboBox.WMDeleteItem(var Message: TWMDeleteItem);
  1040. var
  1041.   ShellItem: TShellItem;
  1042.   DelIndex: Integer;
  1043. begin
  1044.   if not FRecreatingWnd then
  1045.   begin
  1046.     DelIndex := Message.DeleteItemStruct.itemID;
  1047.     ShellItem := TShellItem(Items.Objects[DelIndex]);
  1048.     if ShellItem <> NIL then
  1049.       ShellItem.Free;
  1050.   end;
  1051.  
  1052.   inherited;
  1053. end;
  1054.  
  1055. {*******************************************************************************
  1056. Procedure:    TdfsSystemComboBox.GetActiveFolderIDList
  1057. Parameters:   None
  1058. Notes:
  1059.   Property read method.  Returns the fully qualified PItemIDList of the selected
  1060.   item.
  1061.  
  1062. Revision History
  1063. yyyy/mm/dd        By: change
  1064. 1999/02/07        andrew@vemco.com: Initial
  1065. *******************************************************************************}
  1066. function TdfsSystemComboBox.GetActiveFolderIDList: PItemIDList;
  1067. begin
  1068.   if (ItemIndex >= 0) and (ItemIndex < Items.Count) then
  1069.     Result := TShellItem(Items.Objects[ItemIndex]).FullID
  1070.   else
  1071.     Result := NIL;
  1072. end;
  1073.  
  1074.  
  1075. // Implementation must return the actual ID list.  Caller will make a copy
  1076. // of it it wants it's own.  Implementer owns this one, i.e. it's the "real
  1077. // thing".  If there isn't one, return NIL.
  1078. function TdfsSystemComboBox.GetSelectionPIDL: PItemIDList;
  1079. begin
  1080.   Result := ActiveFolderIDList;
  1081. end;
  1082.  
  1083. function TdfsSystemComboBox.GetSelectionParentFolder: IShellFolder;
  1084. begin
  1085.   Result := FDesktopFolder;
  1086. (*
  1087.   if ItemIndex >= 0 then
  1088.     Result := TShellItem(Items.Objects[ItemIndex]).ParentShellFolder
  1089.   else
  1090.     Result := NIL;
  1091. *)
  1092. end;
  1093.  
  1094. // Implementation notes: IDList parameter belongs to someone else.  If
  1095. // needed by this component, a copy must be made of it.  This differs from
  1096. // the Reset method in that it does not notify linked controls of a change
  1097. // because that could result in an endless cycle of notifications. Return
  1098. // value indicates success or failure.
  1099. function TdfsSystemComboBox.LinkedReset(const ParentFolder: IShellFolder;
  1100.    const IDList: PItemIDList; ForceUpdate: boolean): boolean;
  1101. begin
  1102.  
  1103. {$IFDEF DFS_DEBUG} Debugger.EnterProc('SCB.LinkedReset'); {$ENDIF}
  1104.  
  1105.   Items.BeginUpdate;
  1106.   try
  1107.     PopulateCombo;
  1108.     // ID list belongs to someone else, use a copy!
  1109.     ActiveFolderIDList := CopyPIDL(IDList);
  1110.     Result := ItemIndex > -1;
  1111.   finally
  1112.     Items.EndUpdate;
  1113.   end;
  1114.  
  1115. {$IFDEF DFS_DEBUG} Debugger.LeaveProc('SCB.LinkedReset'); {$ENDIF}
  1116.  
  1117. end;
  1118.  
  1119. function TdfsSystemComboBox.GetVersion: string;
  1120. begin
  1121.   Result := DFS_COMPONENT_COMBO_VERSION;
  1122. end;
  1123.  
  1124. procedure TdfsSystemComboBox.SetVersion(const Val: string);
  1125. begin
  1126.   { empty write method, just needed to get it to show up in Object Inspector }
  1127. end;
  1128.  
  1129.  
  1130. procedure TdfsSystemComboBox.ChangeToParent;
  1131. var
  1132.   ParentPIDL: PItemIDList;
  1133. begin
  1134.   ParentPIDL := CopyParentPIDL(FActiveFolderIDList);
  1135.   try
  1136.     LinkedReset(NIL, ParentPIDL, FALSE);
  1137.     NotifyLinkedControls(FALSE);
  1138.   finally
  1139.     FreePIDL(ParentPIDL);
  1140.   end;
  1141. end;
  1142.  
  1143. { Added by Tamas Demjen }
  1144. procedure TdfsSystemComboBox.CMFontChanged(var Message: TMessage);
  1145. var
  1146.   DC: HDC;
  1147.   OldFont: HFONT;
  1148.   Size: TSize;
  1149. begin
  1150.   DC := GetDC(0);
  1151.   OldFont := SelectObject(DC, Font.Handle);
  1152.   try
  1153.     if GetTextExtentPoint32(DC, '@9Wgp,|"''', -1, Size) then
  1154.       ItemHeight := Size.cy + 2;
  1155.   finally
  1156.     SelectObject(DC, OldFont);
  1157.     ReleaseDC(0, DC);
  1158.   end;
  1159. end;
  1160.  
  1161. end.
  1162.