home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / SystemImageList.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-28  |  39KB  |  978 lines
  1. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  2.  
  3. {------------------------------------------------------------------------------}
  4. { TdfsSystemImageList v1.16                                                    }
  5. {------------------------------------------------------------------------------}
  6. { A component to extend the TImageList so that it gives access to the system   }
  7. { image list.                                                                  }
  8. {                                                                              }
  9. { Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
  10. {                                                                              }
  11. { Copyright:                                                                   }
  12. { All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
  13. { Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
  14. { property of the author.                                                      }
  15. {                                                                              }
  16. { Distribution Rights:                                                         }
  17. { You are granted a non-exlusive, royalty-free right to produce and distribute }
  18. { compiled binary files (executables, DLLs, etc.) that are built with any of   }
  19. { the DFS source code unless specifically stated otherwise.                    }
  20. { You are further granted permission to redistribute any of the DFS source     }
  21. { code in source code form, provided that the original archive as found on the }
  22. { DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
  23. { example, if you create a descendant of TDFSColorButton, you must include in  }
  24. { the distribution package the colorbtn.zip file in the exact form that you    }
  25. { downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
  26. {                                                                              }
  27. { Restrictions:                                                                }
  28. { Without the express written consent of the author, you may not:              }
  29. {   * Distribute modified versions of any DFS source code by itself. You must  }
  30. {     include the original archive as you found it at the DFS site.            }
  31. {   * Sell or lease any portion of DFS source code. You are, of course, free   }
  32. {     to sell any of your own original code that works with, enhances, etc.    }
  33. {     DFS source code.                                                         }
  34. {   * Distribute DFS source code for profit.                                   }
  35. {                                                                              }
  36. { Warranty:                                                                    }
  37. { There is absolutely no warranty of any kind whatsoever with any of the DFS   }
  38. { source code (hereafter "software"). The software is provided to you "AS-IS", }
  39. { and all risks and losses associated with it's use are assumed by you. In no  }
  40. { event shall the author of the softare, Bradley D. Stowers, be held           }
  41. { accountable for any damages or losses that may occur from use or misuse of   }
  42. { the software.                                                                }
  43. {                                                                              }
  44. { Support:                                                                     }
  45. { Support is provided via the DFS Support Forum, which is a web-based message  }
  46. { system.  You can find it at http://www.delphifreestuff.com/discus/           }
  47. { All DFS source code is provided free of charge. As such, I can not guarantee }
  48. { any support whatsoever. While I do try to answer all questions that I        }
  49. { receive, and address all problems that are reported to me, you must          }
  50. { understand that I simply can not guarantee that this will always be so.      }
  51. {                                                                              }
  52. { Clarifications:                                                              }
  53. { If you need any further information, please feel free to contact me directly.}
  54. { This agreement can be found online at my site in the "Miscellaneous" section.}
  55. {------------------------------------------------------------------------------}
  56. { The lateset version of my components are always available on the web at:     }
  57. {   http://www.delphifreestuff.com/                                            }
  58. { See SystemImageList.txt for notes, known issues, and revision history.       }
  59. {------------------------------------------------------------------------------}
  60. { Date last modified:  June 28, 2001                                           }
  61. {------------------------------------------------------------------------------}
  62.  
  63. {CE_Desc_Begin(SystemImageList.pas)}
  64. {This unit provides the <%LINK TdfsSystemImageList%> component which extends \
  65. the TImageList so that it gives access to the Win32 system image list.  The \
  66. system image list is a list of images owned by the Win32 operating system \
  67. that is made up of all the images the OS uses in things like Explorer.}
  68. {CE_Desc_End}
  69. unit SystemImageList;
  70.  
  71. {$IFNDEF DFS_WIN32}
  72.   !! { ERROR!  Only available for Win32! }
  73. {$ENDIF}
  74.  
  75. {CE_Desc_Begin(@LIST_OVERVIEW)}
  76. {<%LINK TdfsSystemImageList%> is the only class provided with this component.
  77.  
  78. There are several unit level functions that are used by the component that \
  79. I have provided in case you want do things at a lower level than using the \
  80. component.}
  81. {CE_Desc_End}
  82.  
  83. {CE_Desc_Begin(@HIERARCHY_OVERVIEW)}
  84. {Their is only the <%LINK TdfsSystemImageList%> component in this package, and it \
  85. descends from TImageList.}
  86. {CE_Desc_End}
  87.  
  88. {CE_Desc_Begin(@UNIT_OVERVIEW)}
  89. {The <%LINK TdfsSystemImageList%> component is wholly contained in the \
  90. SystemImageList.pas unit.}
  91. {CE_Desc_End}
  92.  
  93.  
  94. interface
  95.  
  96. uses
  97.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  98.   CommCtrl, ShlObj;
  99.  
  100. const
  101.   { This shuts up C++Builder 3 about the redefiniton being different. There
  102.     seems to be no equivalent in C1.  Sorry. }
  103.   {$IFDEF DFS_CPPB_3_UP}
  104.   {$EXTERNALSYM DFS_COMPONENT_VERSION}
  105.   {$ENDIF}
  106.   DFS_COMPONENT_VERSION = 'TdfsSystemImageList v1.16';
  107.  
  108. {$IFDEF DFS_COMPILER_2}
  109.   // Delphi 2 and C++Builder 1 don't have these defined in Windows.pas
  110.   // C1 does have them defined in a header file, but Pascal code can't get at
  111.   // those.  So, C1 is going to complain about them being redefined.  Just
  112.   // ignore those two warnings.
  113.   FILE_ATTRIBUTE_COMPRESSED           = $00000800;
  114.   FILE_ATTRIBUTE_OFFLINE              = $00001000;
  115. {$ENDIF}
  116.  
  117. type
  118.   TImageSize = (isLarge, isSmall);
  119.  
  120.   // Note that not all of these are available on every flavor of Win9x/NT4 SPx
  121.   TShellItem = (siDesktop, siInternet, siPrograms, siControlPanel, siPrinters,
  122.      siPersonalDocs, siFavorites, siStartup, siRecentDocs, siSendTo,
  123.      siRecycleBin, siStartMenu, siDrives, siNetworkNeighborhood, siFonts,
  124.      siTemplates, siInternetCache, siCookies, siHistory);
  125.  
  126.   { TSystemFileAttribute is used to provide a Delphi-ish interface for the
  127.     various Win32 file attributes.}
  128.   TSystemFileAttribute = (sfaReadOnly, sfaHidden, sfaSystem, sfaDirectory,
  129.      sfaArchive, sfaNormal, sfaTemporary ,sfaCompressed, sfaOffline);
  130.   { TSystemFileAttributes is a set of TSystemFileAttribute.  This allows you
  131.     to provide more than a single attribute at one time. }
  132.   TSystemFileAttributes = set of TSystemFileAttribute;
  133.  
  134. {CE_Desc_Begin(TdfsSystemImageList)}
  135. {TdfsSystemImageList component which extends the TImageList component so that \
  136. it gives access to the Win32 system image list.  The system image list is \
  137. a list of images owned by the Win32 operating system that is made up of \
  138. all the images the OS uses in things like Explorer.
  139.  
  140. It is derived from TImageList instead of TCustomImageList because \
  141. components such TListView and TTreeView have properties of TImageList \
  142. type.  If it were derived from TCustomImageList, it would not be \
  143. compatible with those properties.  That would make it pretty useless; thanks \
  144. Borland...err...Inprise.}
  145. {CE_Desc_End}
  146.   TdfsSystemImageList = class(TImageList)
  147.   private
  148.     FImageSize: TImageSize;
  149.  
  150.     procedure SetImageSize(Val: TImageSize);
  151.     function GetHeight: integer;
  152.     function GetWidth: integer;
  153.     function GetShareImages: boolean;
  154.     procedure SetShareImages(Val: boolean);
  155.     function GetHandle: HImageList;
  156.   protected
  157.     function GetVersion: string;
  158.     procedure SetVersion(const Val: string);
  159.     procedure SetName(const NewName: TComponentName); override;
  160.     procedure SetImageListHandle(Shared: boolean); virtual;
  161.     procedure Loaded; override;
  162.     // EXTREMELY IMPORTANT!!!!
  163.     procedure WriteState(Writer: TWriter); override;
  164.   public
  165.     constructor Create(AOwner: TComponent); override;
  166.  
  167.     procedure SaveToStream(Stream: TStream); virtual;
  168.  
  169. {CE_Desc_Begin(TdfsSystemImageList.GetImageIndex)}
  170. {The <%BOLD%>GetImageIndex<%BOLD0%> method is used to retrive the index into \
  171. the image list of given filename or directory.  The return value is the image \
  172. index.
  173.  
  174. You must specify the full pathname if you want the system to determine the \
  175. attributes of the file.  In this case, you can simply pass an empty set ( [] ) \
  176. to the <%BOLD%>Attrs<%BOLD0%> parameter.
  177.  
  178. If you do not specify the full pathname, or the file simply does not exist, \
  179. you must specify the attributes to be used in determining the image index.
  180.  
  181. The <%BOLD%>Attrs<%BOLD0%> parameter is a set of zero or more of the following \
  182. values:
  183. <%TABLE%><%BOLD%>sfaReadOnly<%BOLD0%>    The file or directory is read-only. \
  184. Applications can read the file but cannot write to it or delete it. In the \
  185. case of a directory, applications cannot delete it.
  186. <%BOLD%>sfaHidden<%BOLD0%>    The file or directory is hidden. It is not \
  187. included in an ordinary directory listing.
  188. <%BOLD%>sfaSystem<%BOLD0%>    The file or directory is part of, or is used \
  189. exclusively by, the operating system.
  190. <%BOLD%>sfaDirectory<%BOLD0%>    The "file or directory" is a directory.
  191. <%BOLD%>sfaArchive<%BOLD0%>    The file or directory is an archive file or \
  192. directory. Applications use this flag to mark files for backup or removal.
  193. <%BOLD%>sfaNormal<%BOLD0%>    The file or directory has no other attributes set. \
  194. This attribute is valid only if used alone.
  195. <%BOLD%>sfaTemporary<%BOLD0%>    The file is being used for temporary storage. \
  196. File systems attempt to keep all of the data in memory for quicker access \
  197. rather than flushing the data back to mass storage. A temporary file should be \
  198. deleted by the application as soon as it is no longer needed.
  199. <%BOLD%>sfaCompressed<%BOLD0%>    The file or directory is compressed. For a \
  200. file, this means that all of the data in the file is compressed. For a \
  201. directory, this means that compression is the default for newly created files \
  202. and subdirectories.
  203. <%BOLD%>sfaOffline<%BOLD0%>    The data of the file is not immediately available. \
  204. Indicates that the file data has been physically moved to offline storage.
  205. <%ENDTABLE%>
  206.  
  207. <%SEEALSO GetFileInformation%>
  208.  
  209. <%EXAMPLE%>
  210. <%TEXT%>
  211. This example retrieves the image index for a file or directory that does \
  212. exist.  For example, if you were populating a listview with the files in a \
  213. directory on the user's system, this would be appropriate.
  214. <%CODE%>
  215.   function AddListItem(const ARealFilename: string);
  216.   var
  217.     Item: TListItem;
  218.     s: string;
  219.   begin
  220.     SomeListView.Items.BeginUpdate;
  221.     try
  222.       Item := SomeListView.Items.Add;
  223.       // ARealFilename must have full path information
  224.       Item.Caption := ExtractFileName(ARealFileName);
  225.       // The filename is real, so let the system figure out the attributes.
  226.       Item.ImageIndex := SomeSystemImageList.GetImageIndex(ARealFilename, []);
  227.     finally
  228.       SomeListView.Items.EndUpdate;
  229.     end;
  230.   end;
  231.  
  232. <%TEXT%>
  233. This example retrieves the image index for a file type based on it's \
  234. extension. This is appropriate for if you had a listview that was to be filled \
  235. with filenames that did not exist; a zip file viewer or the files on an FTP \
  236. server, for example.
  237. <%CODE%>
  238.   function AddListItem(const AFakeFilename: string, IsADirectory: boolean);
  239.   var
  240.     Item: TListItem;
  241.     s: string;
  242.     Attrs: TSystemFileAttributes;
  243.   begin
  244.     SomeListView.Items.BeginUpdate;
  245.     try
  246.       Item := SomeListView.Items.Add;
  247.       // AFakeFilename does not exist, we must supply the attributes.
  248.       if IsADirectory then
  249.         Attrs := [sfaDirectory] // tell it we want the folder image index.
  250.       else
  251.         Attrs := [sfaNormal]; // figure it out based on file extension.
  252.       Item.ImageIndex := SomeSystemImageList.GetImageIndex(AFakeFilename, Attrs);
  253.     finally
  254.       SomeListView.Items.EndUpdate;
  255.     end;
  256.   end;
  257. }
  258. {CE_Desc_End}
  259.     {$IFDEF DFS_COMPILER_4_UP}
  260.     function GetImageIndex(const APath: string; Selected, Open: boolean;
  261.        Attrs: TSystemFileAttributes): integer; overload;
  262.     function GetImageIndex(const APidl: PItemIDList; Selected,
  263.        Open: boolean ): integer; overload;
  264.     function GetImageIndex(SpecialItem: TShellItem; Selected,
  265.        Open: boolean): integer; overload;
  266.     {$ELSE}
  267.     function GetImageIndex(const APath: string; Selected, Open: boolean;
  268.        Attrs: TSystemFileAttributes): integer;
  269.     function GetImageIndexPIDL(const APidl: PItemIDList; Selected,
  270.        Open: boolean): integer;
  271.     function GetImageIndexSpecial(SpecialItem: TShellItem; Selected,
  272.        Open: boolean): integer;
  273.     {$ENDIF}
  274.  
  275. {CE_Desc_Begin(TdfsSystemImageList.GetFileInformation)}
  276. {The <%BOLD%>GetFileInformation<%BOLD0%> method is identical to the \
  277. <%BOLD%><%LINK GetImageIndex%><%BOLD0%> method with the exception that it also \
  278. retrieves the system description text for the file type.  This text is what \
  279. you see in the <%BOLD%>Type<%BOLD0%> column of Explorer.
  280.  
  281. Simply pass a string variable in the <%BOLD%>Descr<%BOLD0%> parameter and it \
  282. will be assigned the system description text.
  283.  
  284. All other aspects of this method are identical to <%BOLD%>GetImageIndex<%BOLD0%>.
  285.  
  286. <%SEEALSO GetImageIndex%>
  287. }
  288. {CE_Desc_End}
  289.     {$IFDEF DFS_COMPILER_4_UP}
  290.     function GetFileInformation(const APath: string; Selected, Open: boolean;
  291.        Attrs: TSystemFileAttributes; var Descr: string): integer; overload;
  292.     function GetFileInformation(const APidl: PItemIDList; Selected, Open: boolean;
  293.        Attrs: TSystemFileAttributes; var Descr: string): integer; overload;
  294.     function GetFileInformation(SpecialItem: TShellItem; Selected, Open: boolean;
  295.        Attrs: TSystemFileAttributes; var Descr: string): integer; overload;
  296.     {$ELSE}
  297.     function GetFileInformation(const APath: string; Selected, Open: boolean;
  298.        Attrs: TSystemFileAttributes; var Descr: string): integer;
  299.     function GetFileInformationPIDL(const APidl: PItemIDList; Selected, Open: boolean;
  300.        Attrs: TSystemFileAttributes; var Descr: string): integer;
  301.     function GetFileInformationSpecial(SpecialItem: TShellItem; Selected, Open: boolean;
  302.        Attrs: TSystemFileAttributes; var Descr: string): integer;
  303.     {$ENDIF}
  304.  
  305.  
  306.  
  307. {CE_Desc_Begin(TdfsSystemImageList.Handle)}
  308. {The <%BOLD%>Handle<%BOLD0%> property is the Win32 handle of the image list in \
  309. use.  If the <%BOLD%><%LINK ShareImages%><%BOLD0%> property is TRUE, the \
  310. handle is the <%BOLD%>REAL<%BOLD0%> system image list.  That means any changes \
  311. to it will affect the <%ITALIC%><%BOLD%>entire system<%BOLD0%><%ITALIC0%>.  If \
  312. <%BOLD%>ShareImages<%BOLD0%> is FALSE, the component has made a copy of the \
  313. system image list and changes will affect only the component.
  314.  
  315. <%SEEALSO ShareImages%>
  316. }
  317. {CE_Desc_End}
  318.     property Handle: HImageList { read only! }
  319.        read GetHandle;
  320.   published
  321. {CE_Desc_Begin(TdfsSystemImageList.Version)}
  322. {Displays the version number of the component.  This allows you to easily \
  323. compare the version installed with the version you *think* you are using.
  324.  
  325. The property editor for this property also displays the address to my web site \
  326. where you can find the most current version of this component, along with many \
  327. other freeware components written by myself and others.}
  328. {CE_Desc_End}
  329.     property Version: string
  330.        read GetVersion
  331.        write SetVersion
  332.        stored FALSE;
  333. {CE_Desc_Begin(TdfsSystemImageList.ImageSize)}
  334. {<%BOLD%>ImageSize<%BOLD0%> indicates what size image is to be provided by the \
  335. component.
  336.  
  337. Possible values are:
  338. <%TABLE%><%BOLD%>isLarge<%BOLD0%>    The large image list is most commonly used \
  339. for list view controls with ViewStyle set to vsIcon.
  340. <%BOLD%>isSmall<%BOLD0%>    The small image list is most commonly used for list \
  341. view controls with ViewStyle set to a value other than vsIcon, and also tree \
  342. view controls.
  343. <%ENDTABLE%>
  344. If you need to determine the exact size of either large or small images in the \
  345. list, use the <%BOLD%><%LINK Height%><%BOLD0%> and <%BOLD%><%LINK Width%> \
  346. <%BOLD0%> properties.
  347.  
  348. <%SEEALSO Height, Width%>
  349. }
  350. {CE_Desc_End}
  351.     property ImageSize: TImageSize
  352.        read FImageSize
  353.        write SetImageSize
  354.        default isLarge;
  355. {CE_Desc_Begin(TdfsSystemImageList.Height)}
  356. {The <%BOLD%>Height<%BOLD0%> property is used to report the height of the \
  357. images contained in the list.  You can not directly change this value since \
  358. it is dictated by the system.  To change the size of images in the list, use \
  359. the <%BOLD%><%LINK ImageSize%><%BOLD0%> property.
  360.  
  361. <%SEEALSO Width, ImageSize%>
  362. }
  363. {CE_Desc_End}
  364.     property Height: integer
  365.        read GetHeight { read only! }
  366.        stored FALSE;
  367. {CE_Desc_Begin(TdfsSystemImageList.Width)}
  368. {The <%BOLD%>Width<%BOLD0%> property is used to report the width of the \
  369. images contained in the list.  You can not directly change this value since \
  370. it is dictated by the system.  To change the size of images in the list, use \
  371. the <%BOLD%><%LINK ImageSize%><%BOLD0%> property.
  372.  
  373. <%SEEALSO Height, ImageSize%>
  374. }
  375. {CE_Desc_End}
  376.     property Width: integer
  377.        read GetWidth { read only! }
  378.        stored FALSE;
  379. {CE_Desc_Begin(TdfsSystemImageList.ShareImages)}
  380. {The <%BOLD%>ShareImages<%BOLD0%> property is used to indicate whether the \
  381. component should use the <%BOLD%>real<%BOLD0%> system image list or make a \
  382. copy of it for the components used.
  383.  
  384. Using the real system image list means any changes made to it will affect the \
  385. <%ITALIC%><%BOLD%>entire system<%BOLD0%><%ITALIC0%> until it is restarted.
  386.  
  387. <%NOTE%>For safety reasons, you should always set <%BOLD%>ShareImages<%BOLD0%> \
  388. to TRUE when it is possible.  The drawback to doing this is that it can be \
  389. quite time consuming to make the initial copy of the system's image list (it \
  390. can be very large, upwards of several megabytes).
  391.  
  392. <%SEEALSO Handle%>
  393. }
  394. {CE_Desc_End}
  395.     property ShareImages: boolean
  396.        read GetShareImages
  397.        write SetShareImages
  398.        nodefault;
  399.   end;
  400.  
  401.  
  402. {CE_Desc_Begin(GeTdfsSystemImageList)}
  403. {<%BOLD%>GeTdfsSystemImageList<%BOLD0%> is a function that is can be used to get \
  404. the handle of the system's large and small image list.  This list is \
  405. <%BOLD%>owned by the system<%BOLD0%>.  It is <%BOLD%>NOT<%BOLD0%> a copy.
  406.  
  407. The <%BOLD%>Large<%BOLD0%> parameter indicates whether to return the image \
  408. list handle that contains large or small icons.
  409.  
  410. You should <%ITALIC%><%BOLD%>never<%BOLD0%><%ITALIC0%> free this handle when \
  411. you are done with it.  Doing so will leave the entire OS without an image \
  412. list.  Explorer looks damn funny that way.}
  413. {CE_Desc_End}
  414. function GeTdfsSystemImageList(Large: boolean): HImageList;
  415.  
  416. {CE_Desc_Begin(GetIconIndex)}
  417. {Retrieves the index into the system image list of a file or directory item. \
  418. If the item does not exist, the <%BOLD%>Attrs<%BOLD0%> parameter is used to \
  419. describe its attributes. If the file does exist, <%BOLD%>Attrs<%BOLD0%> is \
  420. ignored.
  421.  
  422. The <%BOLD%>Attrs<%BOLD0%> parameter accepts any of the \
  423. <%BOLD%>FILE_ATTRIBUTE_xxx<%BOLD0%> constants ORed together bitwise, or 0 if \
  424. the system should determine the attributes itself.  You can find a list of \
  425. these constants in the Win32.hlp file under the \
  426. <%BOLD%>GetFileAttributes<%BOLD0%> topic.
  427.  
  428. <%SEEALSO GetFileInfo%>
  429. <%EXAMPLE%>
  430. <%TEXT%>
  431. If you wanted to get the index of a file, say c:\windows\notepad.exe, that did \
  432. exist, you would call it like this:
  433. <%CODE%>
  434.   Index := GetIconIndex('c:\windows\notepad.exe', 0);
  435.  
  436. <%TEXT%>
  437. If you wanted to get the index for a file that did not exist, you would need \
  438. to specify what file attributes should be used in determining the image index.
  439. <%CODE%>
  440.   Index := GetIconIndex('c:\bogus\dir\badfile.html', FILE_ATTRIBUTE_NORMAL);
  441. }
  442. {CE_Desc_End}
  443. {$IFDEF DFS_COMPILER_4_UP}
  444. function GetIconIndex(const APath: string; Selected, Open: boolean;
  445.   Attrs: DWORD; AlwaysUseAttrs: boolean): integer; overload;
  446. function GetIconIndex(const APidl: PItemIDList; Selected,
  447.   Open: boolean): integer; overload;
  448. function GetIconIndex(SpecialItem: TShellItem; Selected,
  449.   Open: boolean): integer; overload;
  450. {$ELSE}
  451. function GetIconIndex(const APath: string; Selected, Open: boolean;
  452.   Attrs: DWORD; AlwaysUseAttrs: boolean): integer;
  453. function GetIconIndexPIDL(const APidl: PItemIDList; Selected,
  454.   Open: boolean): integer;
  455. function GetIconIndexSpecial(SpecialItem: TShellItem; Selected,
  456.   Open: boolean): integer;
  457. {$ENDIF}
  458.  
  459. {CE_Desc_Begin(GetFileInfo)}
  460. {This function is exactly the same as <%BOLD%><%LINK GetIconIndex%><%BOLD0%> \
  461. except that it takes an extra variable parameter that is assigned the system \
  462. description for the file.  The contents of this string parameter does not \
  463. matter when the function is called, it is used strictly for output.
  464.  
  465. <%SEEALSO GetIconIndex%>
  466. }
  467. {CE_Desc_End}
  468. {$IFDEF DFS_COMPILER_4_UP}
  469. function GetFileInfo(const APath: string; Selected, Open: boolean; Attrs: DWORD;
  470.    AlwaysUseAttrs: boolean; var Descr: string): integer; overload;
  471. function GetFileInfo(const APidl: PItemIDList; Selected, Open: boolean; Attrs: DWORD;
  472.    AlwaysUseAttrs: boolean; var Descr: string): integer; overload;
  473. function GetFileInfo(SpecialItem: TShellItem; Selected, Open: boolean; Attrs: DWORD;
  474.    AlwaysUseAttrs: boolean; var Descr: string): integer; overload;
  475. {$ELSE}
  476. function GetFileInfo(const APath: string; Selected, Open: boolean; Attrs: DWORD;
  477.    AlwaysUseAttrs: boolean; var Descr: string): integer;
  478. function GetFileInfoPIDL(const APidl: PItemIDList; Selected, Open: boolean;
  479.    Attrs: DWORD; AlwaysUseAttrs: boolean; var Descr: string): integer;
  480. function GetFileInfoSpecial(SpecialItem: TShellItem; Selected, Open: boolean;
  481.    Attrs: DWORD; AlwaysUseAttrs: boolean; var Descr: string): integer;
  482. {$ENDIF}
  483.  
  484.  
  485. implementation
  486.  
  487.  
  488. uses
  489.   ShellAPI,
  490.   {$IFDEF DFS_COMPILER_3_UP} ActiveX, {$ELSE} OLE2, {$ENDIF}
  491.   FileCtrl;
  492.  
  493.  
  494. // I'll get to it in a minute, now shut up compiler.
  495. function SFA2API(Attrs: TSystemFileAttributes): DWORD; forward;
  496. function GetValidHandle(ImgList: TdfsSystemImageList): HWND; forward;
  497.  
  498.  
  499. constructor TdfsSystemImageList.Create(AOwner: TComponent);
  500. begin
  501.   inherited Create(AOwner);
  502.   FImageSize := isLarge;
  503.   ShareImages := TRUE;
  504. end;
  505.  
  506. procedure TdfsSystemImageList.SetName(const NewName: TComponentName);
  507. begin
  508.   inherited SetName(NewName);
  509.   // I really couldn't give a flying doughnut about SetName, I just needed
  510.   // something I could override that would happen when the component was being
  511.   // created dynamically so I could create the handle.  In a windowed component,
  512.   // I could override CreateWnd which would make sense, but this little freak
  513.   // doesn't make it's CreateHandle virtual.  Matter of fact, it makes damn
  514.   // little of itself virtual, making my life a lot harder than it should be.
  515.   // Can you tell I'm really ticked off at the moment?
  516.  
  517.   // If it isn't loading, create the handle.  If it is, wait until all
  518.   // properties have been loaded before doing it so we don't have to recreate
  519.   // it every time one changes.
  520.   if not (csLoading in ComponentState) then
  521.     SetImageListHandle(ShareImages);
  522. end;
  523.  
  524. procedure TdfsSystemImageList.Loaded;
  525. begin
  526.   inherited Loaded;
  527.   SetImageListHandle(ShareImages);
  528. end;
  529.  
  530. procedure TdfsSystemImageList.WriteState(Writer: TWriter);
  531. var
  532.   TempHandle: HImageList;
  533. begin
  534.   // We don't want the system image list being streamed out to disk.  It is
  535.   // like a couple of meg in size.
  536.   TempHandle := Handle;
  537.   inherited Handle := 0;
  538.   inherited WriteState(Writer);
  539.   inherited Handle := TempHandle;
  540. end;
  541.  
  542. procedure TdfsSystemImageList.SetImageListHandle(Shared: boolean);
  543. var
  544.   TempHandle: HImageList;
  545.   TempList: TImageList;
  546.   OldCursor: TCursor;
  547. begin
  548.   { if we have a handle already, this will get rid of it according to
  549.     ShareImages property }
  550.   inherited Handle := 0;
  551.  
  552.   TempHandle := GeTdfsSystemImageList(FImageSize = isLarge);
  553.   if Shared then
  554.     // give them the real thing
  555.     inherited Handle := TempHandle
  556.   else begin
  557.     // make a copy of it.  This can be quite slow.
  558.     TempList := TImageList.Create(Self);
  559.     OldCursor := Screen.Cursor;
  560.     Screen.Cursor := crHourglass;
  561.     try
  562.       TempList.ShareImages := TRUE;
  563.       TempList.Handle := TempHandle;
  564.       Assign(TempList);
  565.     finally
  566.       Screen.Cursor := OldCursor;
  567.       TempList.Free;
  568.     end;
  569.   end;
  570. end;
  571.  
  572. procedure TdfsSystemImageList.SetImageSize(Val: TImageSize);
  573. begin
  574.   if FImageSize <> Val then
  575.   begin
  576.     FImageSize := Val;
  577.     if HandleAllocated then
  578.       SetImageListHandle(ShareImages);
  579.   end;
  580. end;
  581.  
  582. function TdfsSystemImageList.GetHeight: integer;
  583. begin
  584.   Result := inherited Height;
  585. end;
  586.  
  587. function TdfsSystemImageList.GetWidth: integer;
  588. begin
  589.   Result := inherited Width;
  590. end;
  591.  
  592. function TdfsSystemImageList.GetShareImages: boolean;
  593. begin
  594.   Result := inherited ShareImages;
  595. end;
  596.  
  597. procedure TdfsSystemImageList.SetShareImages(Val: boolean);
  598. begin
  599.   if HandleAllocated then
  600.     SetImageListHandle(Val);
  601.   inherited ShareImages := Val;
  602. end;
  603.  
  604. function TdfsSystemImageList.GetHandle: HImageList;
  605. begin
  606.   if not HandleAllocated then
  607.     SetImageListHandle(ShareImages);
  608.   Result := inherited Handle;
  609. end;
  610.  
  611. // Only need Attrs if APath doesn't exist, otherwise just pass []
  612. function TdfsSystemImageList.GetImageIndex(const APath: string; Selected,
  613.    Open: boolean; Attrs: TSystemFileAttributes): integer;
  614. begin
  615.   Result := GetIconIndex(APath, Selected, Open, SFA2API(Attrs), Attrs <> []);
  616. end;
  617.  
  618. {$IFDEF DFS_COMPILER_4_UP}
  619. function TdfsSystemImageList.GetImageIndex(const APidl: PItemIDList;
  620.    Selected, Open: boolean): integer;
  621. begin
  622.   Result := GetIconIndex(APidl, Selected, Open);
  623. end;
  624. {$ELSE}
  625. function TdfsSystemImageList.GetImageIndexPIDL(const APidl: PItemIDList;
  626.    Selected, Open: boolean): integer;
  627. begin
  628.   Result := GetIconIndexPIDL(APidl, Selected, Open);
  629. end;
  630. {$ENDIF}
  631.  
  632. {$IFDEF DFS_COMPILER_4_UP}
  633. function TdfsSystemImageList.GetImageIndex(SpecialItem: TShellItem;
  634.    Selected, Open: boolean): integer;
  635. begin
  636.   Result := GetIconIndex(SpecialItem, Selected, Open);
  637. end;
  638. {$ELSE}
  639. function TdfsSystemImageList.GetImageIndexSpecial(SpecialItem: TShellItem;
  640.    Selected, Open: boolean): integer;
  641. begin
  642.   Result := GetIconIndexSpecial(SpecialItem, Selected, Open);
  643. end;
  644. {$ENDIF}
  645.  
  646.  
  647. // Only need Attrs if APath doesn't exist, otherwise just pass []
  648. function TdfsSystemImageList.GetFileInformation(const APath: string;
  649.    Selected, Open: boolean; Attrs: TSystemFileAttributes;
  650.    var Descr: string): integer;
  651. begin
  652.   Result := GetFileInfo(APath, Selected, Open, SFA2API(Attrs), Attrs <> [], Descr);
  653. end;
  654.  
  655. {$IFDEF DFS_COMPILER_4_UP}
  656. function TdfsSystemImageList.GetFileInformation(const APidl: PItemIDList;
  657.    Selected, Open: boolean; Attrs: TSystemFileAttributes;
  658.    var Descr: string): integer;
  659. begin
  660.   Result := GetFileInfo(APidl, Selected, Open, SFA2API(Attrs), Attrs <> [], Descr);
  661. end;
  662. {$ELSE}
  663. function TdfsSystemImageList.GetFileInformationPIDL(const APidl: PItemIDList;
  664.    Selected, Open: boolean; Attrs: TSystemFileAttributes;
  665.    var Descr: string): integer;
  666. begin
  667.   Result := GetFileInfoPIDL(APidl, Selected, Open, SFA2API(Attrs), Attrs <> [],
  668.     Descr);
  669. end;
  670. {$ENDIF}
  671.  
  672. {$IFDEF DFS_COMPILER_4_UP}
  673. function TdfsSystemImageList.GetFileInformation(SpecialItem: TShellItem;
  674.    Selected, Open: boolean; Attrs: TSystemFileAttributes;
  675.    var Descr: string): integer;
  676. begin
  677.   Result := GetFileInfo(SpecialItem, Selected, Open, SFA2API(Attrs), Attrs <> [],
  678.     Descr);
  679. end;
  680. {$ELSE}
  681. function TdfsSystemImageList.GetFileInformationSpecial(SpecialItem: TShellItem;
  682.    Selected, Open: boolean; Attrs: TSystemFileAttributes;
  683.    var Descr: string): integer;
  684. begin
  685.   Result := GetFileInfoSpecial(SpecialItem, Selected, Open, SFA2API(Attrs),
  686.     Attrs <> [], Descr);
  687. end;
  688. {$ENDIF}
  689.  
  690.  
  691. function TdfsSystemImageList.GetVersion: string;
  692. begin
  693.   Result := DFS_COMPONENT_VERSION;
  694. end;
  695.  
  696. procedure TdfsSystemImageList.SetVersion(const Val: string);
  697. begin
  698.   { empty write method, just needed to get it to show up in Object Inspector }
  699. end;
  700.  
  701. // Needed to support the "Save to bitmap" component editor.
  702. procedure TdfsSystemImageList.SaveToStream(Stream: TStream);
  703. var
  704.   DIB1, DIB2: TBitmap;
  705.   DC: HDC;
  706.   S: TMemoryStream;
  707.  
  708.   procedure WriteDIB(BM: HBitmap);
  709.     { The ImageList leaves its bitmap handle selected into a DC somewhere,
  710.       so we can't select it into our own DC to copy from it.  The only safe
  711.       operation is GetDIB (GetDIBits), which extracts the pixel bits without
  712.       selecting the BM into a DC.  This code builds our own bitmap from
  713.       those bits, then crops it to the minimum size before writing it out.}
  714.   var
  715.     BitsSize: DWORD;
  716.     Header, Bits: PChar;
  717.     DIBBits: Pointer;
  718.     R: TRect;
  719.     HeaderSize: DWORD;
  720.     GlyphsPerRow, Rows: Integer;
  721.   begin
  722.     if BM = 0 then Exit;
  723.     GetDIBSizes(BM, HeaderSize, BitsSize);
  724.     GetMem(Header, HeaderSize + BitsSize);
  725.     try
  726.       Bits := Header + HeaderSize;
  727.       GetDIB(BM, 0, Header^, Bits^);
  728.       DIB1.Handle := CreateDIBSection(DC, PBitmapInfo(Header)^, DIB_RGB_COLORS,
  729.          {$IFDEF DFS_COMPILER_2}
  730.          DIBBits, NIL, 0);
  731.          {$ELSE}
  732.          DIBBits, 0, 0);
  733.          {$ENDIF}
  734.       System.Move(Bits^, DIBBits^, BitsSize);
  735.       with PBitmapInfo(Header)^.bmiHeader do
  736.       begin
  737.         GlyphsPerRow := biWidth div Width;
  738.         if GlyphsPerRow = 0 then Inc(GlyphsPerRow);
  739.         if GlyphsPerRow > Count then GlyphsPerRow := Count;
  740.         biWidth := GlyphsPerRow * Width;
  741.         Rows := Count div GlyphsPerRow;
  742.         if Count > Rows * GlyphsPerRow then Inc(Rows);
  743.         biHeight := Rows * Height;
  744.         R := Rect(0, 0, biWidth, biHeight);
  745.       end;
  746.       DIB2.Handle := CreateDIBSection(DC, PBitmapInfo(Header)^, DIB_RGB_COLORS,
  747.          {$IFDEF DFS_COMPILER_2}
  748.          DIBBits, NIL, 0);
  749.          {$ELSE}
  750.          DIBBits, 0, 0);
  751.          {$ENDIF}
  752.       DIB2.Canvas.CopyRect(R, DIB1.Canvas, R);
  753.       DIB2.SaveToStream(S);
  754.     finally
  755.       FreeMem(Header);
  756.     end;
  757.   end;
  758.  
  759. begin
  760.   DIB1 := nil;
  761.   DIB2 := nil;
  762.   DC := 0;
  763.   S := TMemoryStream.Create;
  764.   try
  765.     DIB1 := TBitmap.Create;
  766.     DIB2 := TBitmap.Create;
  767.     DC := GetDC(0);
  768.     WriteDIB(GetImageBitmap);
  769.     Stream.WriteBuffer(S.Memory^, S.Size);
  770.   finally
  771.     ReleaseDC(0, DC);
  772.     DIB1.Free;
  773.     DIB2.Free;
  774.     S.Free;
  775.   end;
  776. end;
  777.  
  778. {------------------------------------------------------------------------------}
  779. { Utility functions                                                            }
  780. {------------------------------------------------------------------------------}
  781.  
  782. function GetValidHandle(ImgList: TdfsSystemImageList): HWND;
  783. begin
  784.   if assigned(ImgList) and assigned(ImgList.Owner) and
  785.     (ImgList.Owner is TWinControl) and TWinControl(ImgList.Owner).HandleAllocated then
  786.     Result := TWinControl(ImgList.Owner).Handle
  787.   else if assigned(ImgList) and (ImgList.Owner is TControl) and
  788.     (GetParentForm(TControl(ImgList.Owner)) <> NIL) and (GetParentForm(
  789.     TControl(ImgList.Owner)).HandleAllocated) then
  790.     Result := GetParentForm(TControl(ImgList.Owner)).Handle
  791.   else if assigned(Application.MainForm) and
  792.      Application.MainForm.HandleAllocated then
  793.     Result := Application.MainForm.Handle
  794.   else
  795.     Result := 0;
  796. end;
  797.  
  798.  
  799. function SFA2API(Attrs: TSystemFileAttributes): DWORD;
  800. const
  801.   API_VALUES: array[TSystemFileAttribute] of DWORD = (
  802.      FILE_ATTRIBUTE_READONLY, FILE_ATTRIBUTE_HIDDEN, FILE_ATTRIBUTE_SYSTEM,
  803.      FILE_ATTRIBUTE_DIRECTORY, FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_NORMAL,
  804.      FILE_ATTRIBUTE_TEMPORARY, FILE_ATTRIBUTE_COMPRESSED, FILE_ATTRIBUTE_OFFLINE);
  805. var
  806.   x: TSystemFileAttribute;
  807. begin
  808.   Result := 0;
  809.   for x := Low(x) to High(x) do
  810.     if x in Attrs then
  811.       Result := Result or API_VALUES[x];
  812. end;
  813.  
  814. function SI2API(Item: TShellItem): integer;
  815. const
  816.   {$IFNDEF DFS_COMPILER_4_UP}
  817.   CSIDL_INTERNET        = $0001;
  818.   CSIDL_INTERNET_CACHE  = $0020;
  819.   CSIDL_COOKIES         = $0021;
  820.   CSIDL_HISTORY         = $0022;
  821.   {$ENDIF}
  822.   API_VALUES: array[TShellItem] of integer = (
  823.      CSIDL_DESKTOP, CSIDL_INTERNET, CSIDL_PROGRAMS, CSIDL_CONTROLS,
  824.      CSIDL_PRINTERS, CSIDL_PERSONAL, CSIDL_FAVORITES, CSIDL_STARTUP,
  825.      CSIDL_RECENT, CSIDL_SENDTO, CSIDL_BITBUCKET, CSIDL_STARTMENU, CSIDL_DRIVES,
  826.      CSIDL_NETWORK, CSIDL_FONTS, CSIDL_TEMPLATES, CSIDL_INTERNET_CACHE,
  827.      CSIDL_COOKIES, CSIDL_HISTORY);
  828.  
  829. begin
  830.   Result := API_VALUES[Item];
  831. end;
  832.  
  833. function GeTdfsSystemImageList(Large: boolean): HImageList;
  834. var
  835.   SFI: TSHFileInfo;
  836. begin
  837.   // SHGetFileInfo puts the requested information in the SFI variable, but it
  838.   // also can return the handle of the system image list.  We just pass an
  839.   // empty file because we aren't interested in it, only the returned handle.
  840.   if Large then
  841.     Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
  842.                             SHGFI_SYSICONINDEX or SHGFI_LARGEICON)
  843.   else
  844.     Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
  845.                             SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  846. end;
  847.  
  848. const
  849.   SELECTED_FLAG: array[boolean] of DWORD = (0, SHGFI_SELECTED);
  850.   OPEN_FLAG: array[boolean] of DWORD = (0, SHGFI_OPENICON);
  851.  
  852. function GetIconIndex(const APath: string; Selected, Open: boolean;
  853.    Attrs: DWORD; AlwaysUseAttrs: boolean): integer;
  854. var
  855.   SFI: TSHFileInfo;
  856. begin
  857.   if (not AlwaysUseAttrs) and (FileExists(APath) or DirectoryExists(APath)) then
  858.     // If the file or directory exists, just let Windows figure out it's attrs.
  859.     SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo),
  860.        SHGFI_SYSICONINDEX or OPEN_FLAG[Open] or SELECTED_FLAG[Selected])
  861.   else
  862.     // File doesn't exist, so Windows doesn't know what to do with it.  We have
  863.     // to tell it by passing the attributes we want, and specifying the
  864.     // SHGFI_USEFILEATTRIBUTES flag so that the function knows to use them.
  865.     SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
  866.        SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES or OPEN_FLAG[Open] or
  867.        SELECTED_FLAG[Selected]);
  868.   Result := SFI.iIcon;
  869. end;
  870.  
  871. {$IFDEF DFS_COMPILER_4_UP}
  872. function GetIconIndex(const APidl: PItemIDList; Selected, Open: boolean
  873. {$ELSE}
  874. function GetIconIndexPIDL(const APidl: PItemIDList; Selected, Open: boolean
  875. {$ENDIF}
  876.    ): integer;
  877. var
  878.   SFI: TSHFileInfo;
  879. begin
  880.   SHGetFileInfo(PAnsiChar(APidl), 0, SFI, SizeOf(TSHFileInfo),
  881.      SHGFI_PIDL or SHGFI_SYSICONINDEX or OPEN_FLAG[Open] or
  882.      SELECTED_FLAG[Selected]);
  883.   Result := SFI.iIcon;
  884. end;
  885.  
  886. {$IFDEF DFS_COMPILER_4_UP}
  887. function GetIconIndex(SpecialItem: TShellItem; Selected, Open: boolean
  888. {$ELSE}
  889. function GetIconIndexSpecial(SpecialItem: TShellItem; Selected, Open: boolean
  890. {$ENDIF}
  891.   ): integer;
  892. var
  893.   pidl: PItemIDList;
  894.   ShellMalloc: IMalloc;
  895. begin
  896.   SHGetMalloc(ShellMalloc);
  897.   SHGetSpecialFolderLocation(GetValidHandle(NIL), SI2API(SpecialItem),
  898.      pidl);
  899.   try
  900.     {$IFDEF DFS_COMPILER_4_UP}
  901.     Result := GetIconIndex(pidl, Selected, Open);
  902.     {$ELSE}
  903.     Result := GetIconIndexPIDL(pidl, Selected, Open);
  904.     {$ENDIF}
  905.   finally
  906.     ShellMalloc.Free(pidl);
  907.     {$IFNDEF DFS_NO_COM_CLEANUP} // Delphi 2 won't free automatically, 3 and up will
  908.     ShellMalloc.Release;
  909.     {$ENDIF}
  910.   end;
  911. end;
  912.  
  913.  
  914. function GetFileInfo(const APath: string; Selected, Open: boolean; Attrs: DWORD;
  915.    AlwaysUseAttrs: boolean; var Descr: string): integer;
  916. const
  917.   SELECTED_FLAG: array[boolean] of DWORD = (0, SHGFI_SELECTED);
  918. var
  919.   SFI: TSHFileInfo;
  920. begin
  921.   if FileExists(APath) or DirectoryExists(APath) then
  922.     SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
  923.        SHGFI_TYPENAME or SHGFI_SYSICONINDEX or OPEN_FLAG[Open] or
  924.        SELECTED_FLAG[Selected])
  925.   else
  926.     SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
  927.        SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES or
  928.        OPEN_FLAG[Open] or SELECTED_FLAG[Selected]);
  929.   Descr := SFI.szTypeName;
  930.   Result := SFI.iIcon;
  931. end;
  932.  
  933. {$IFDEF DFS_COMPILER_4_UP}
  934. function GetFileInfo(const APidl: PItemIDList; Selected, Open: boolean;
  935. {$ELSE}
  936. function GetFileInfoPIDL(const APidl: PItemIDList; Selected, Open: boolean;
  937. {$ENDIF}
  938.    Attrs: DWORD; AlwaysUseAttrs: boolean; var Descr: string): integer;
  939. var
  940.   SFI: TSHFileInfo;
  941. begin
  942.   SHGetFileInfo(PAnsiChar(APidl), 0, SFI, SizeOf(TSHFileInfo),
  943.      SHGFI_PIDL or SHGFI_TYPENAME or SHGFI_SYSICONINDEX or OPEN_FLAG[Open] or
  944.      SELECTED_FLAG[Selected]);
  945.   Descr := SFI.szTypeName;
  946.   Result := SFI.iIcon;
  947. end;
  948.  
  949. {$IFDEF DFS_COMPILER_4_UP}
  950. function GetFileInfo(SpecialItem: TShellItem; Selected, Open: boolean;
  951. {$ELSE}
  952. function GetFileInfoSpecial(SpecialItem: TShellItem; Selected, Open: boolean;
  953. {$ENDIF}
  954.    Attrs: DWORD; AlwaysUseAttrs: boolean; var Descr: string): integer;
  955. var
  956.   pidl: PItemIDList;
  957.   ShellMalloc: IMalloc;
  958. begin
  959.   SHGetMalloc(ShellMalloc);
  960.   SHGetSpecialFolderLocation(GetValidHandle(NIL), SI2API(SpecialItem),
  961.      pidl);
  962.   try
  963.     {$IFDEF DFS_COMPILER_4_UP}
  964.     Result := GetFileInfo(pidl, Selected, Open, Attrs, AlwaysUseAttrs, Descr);
  965.     {$ELSE}
  966.     Result := GetFileInfoPIDL(pidl, Selected, Open, Attrs, AlwaysUseAttrs, Descr);
  967.     {$ENDIF}
  968.   finally
  969.     ShellMalloc.Free(pidl);
  970.     {$IFNDEF DFS_NO_COM_CLEANUP} // Delphi 2 won't free automatically, 3 and up will
  971.     ShellMalloc.Release;
  972.     {$ENDIF}
  973.   end;
  974. end;
  975.  
  976.  
  977. end.
  978.