systemimagelist.pas

动态提示控件

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{------------------------------------------------------------------------------}
{ TdfsSystemImageList v1.16                                                    }
{------------------------------------------------------------------------------}
{ A component to extend the TImageList so that it gives access to the system   }
{ image list.                                                                  }
{                                                                              }
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TDFSColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive, and address all problems that are reported to me, you must          }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See SystemImageList.txt for notes, known issues, and revision history.       }
{------------------------------------------------------------------------------}
{ Date last modified:  June 28, 2001                                           }
{------------------------------------------------------------------------------}

{CE_Desc_Begin(SystemImageList.pas)}
{This unit provides the <%LINK TdfsSystemImageList%> component which extends \
the TImageList so that it gives access to the Win32 system image list.  The \
system image list is a list of images owned by the Win32 operating system \
that is made up of all the images the OS uses in things like Explorer.}
{CE_Desc_End}
unit SystemImageList;

{$IFNDEF DFS_WIN32}
  !! { ERROR!  Only available for Win32! }
{$ENDIF}

{CE_Desc_Begin(@LIST_OVERVIEW)}
{<%LINK TdfsSystemImageList%> is the only class provided with this component.

There are several unit level functions that are used by the component that \
I have provided in case you want do things at a lower level than using the \
component.}
{CE_Desc_End}

{CE_Desc_Begin(@HIERARCHY_OVERVIEW)}
{Their is only the <%LINK TdfsSystemImageList%> component in this package, and it \
descends from TImageList.}
{CE_Desc_End}

{CE_Desc_Begin(@UNIT_OVERVIEW)}
{The <%LINK TdfsSystemImageList%> component is wholly contained in the \
SystemImageList.pas unit.}
{CE_Desc_End}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  CommCtrl, ShlObj;

const
  { This shuts up C++Builder 3 about the redefiniton being different. There
    seems to be no equivalent in C1.  Sorry. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM DFS_COMPONENT_VERSION}
  {$ENDIF}
  DFS_COMPONENT_VERSION = 'TdfsSystemImageList v1.16';

{$IFDEF DFS_COMPILER_2}
  // Delphi 2 and C++Builder 1 don't have these defined in Windows.pas
  // C1 does have them defined in a header file, but Pascal code can't get at
  // those.  So, C1 is going to complain about them being redefined.  Just
  // ignore those two warnings.
  FILE_ATTRIBUTE_COMPRESSED           = $00000800;
  FILE_ATTRIBUTE_OFFLINE              = $00001000;
{$ENDIF}

type
  TImageSize = (isLarge, isSmall);

  // Note that not all of these are available on every flavor of Win9x/NT4 SPx
  TShellItem = (siDesktop, siInternet, siPrograms, siControlPanel, siPrinters,
     siPersonalDocs, siFavorites, siStartup, siRecentDocs, siSendTo,
     siRecycleBin, siStartMenu, siDrives, siNetworkNeighborhood, siFonts,
     siTemplates, siInternetCache, siCookies, siHistory);

  { TSystemFileAttribute is used to provide a Delphi-ish interface for the
    various Win32 file attributes.}
  TSystemFileAttribute = (sfaReadOnly, sfaHidden, sfaSystem, sfaDirectory,
     sfaArchive, sfaNormal, sfaTemporary ,sfaCompressed, sfaOffline);
  { TSystemFileAttributes is a set of TSystemFileAttribute.  This allows you
    to provide more than a single attribute at one time. }
  TSystemFileAttributes = set of TSystemFileAttribute;

{CE_Desc_Begin(TdfsSystemImageList)}
{TdfsSystemImageList component which extends the TImageList component so that \
it gives access to the Win32 system image list.  The system image list is \
a list of images owned by the Win32 operating system that is made up of \
all the images the OS uses in things like Explorer.

It is derived from TImageList instead of TCustomImageList because \
components such TListView and TTreeView have properties of TImageList \
type.  If it were derived from TCustomImageList, it would not be \
compatible with those properties.  That would make it pretty useless; thanks \
Borland...err...Inprise.}
{CE_Desc_End}
  TdfsSystemImageList = class(TImageList)
  private
    FImageSize: TImageSize;

    procedure SetImageSize(Val: TImageSize);
    function GetHeight: integer;
    function GetWidth: integer;
    function GetShareImages: boolean;
    procedure SetShareImages(Val: boolean);
    function GetHandle: HImageList;
  protected
    function GetVersion: string;
    procedure SetVersion(const Val: string);
    procedure SetName(const NewName: TComponentName); override;
    procedure SetImageListHandle(Shared: boolean); virtual;
    procedure Loaded; override;
    // EXTREMELY IMPORTANT!!!!
    procedure WriteState(Writer: TWriter); override;
  public
    constructor Create(AOwner: TComponent); override;

    procedure SaveToStream(Stream: TStream); virtual;

{CE_Desc_Begin(TdfsSystemImageList.GetImageIndex)}
{The <%BOLD%>GetImageIndex<%BOLD0%> method is used to retrive the index into \
the image list of given filename or directory.  The return value is the image \
index.

You must specify the full pathname if you want the system to determine the \
attributes of the file.  In this case, you can simply pass an empty set ( [] ) \
to the <%BOLD%>Attrs<%BOLD0%> parameter.

If you do not specify the full pathname, or the file simply does not exist, \
you must specify the attributes to be used in determining the image index.

The <%BOLD%>Attrs<%BOLD0%> parameter is a set of zero or more of the following \
values:
<%TABLE%><%BOLD%>sfaReadOnly<%BOLD0%>	The file or directory is read-only. \
Applications can read the file but cannot write to it or delete it. In the \
case of a directory, applications cannot delete it.
<%BOLD%>sfaHidden<%BOLD0%>	The file or directory is hidden. It is not \
included in an ordinary directory listing.
<%BOLD%>sfaSystem<%BOLD0%>	The file or directory is part of, or is used \
exclusively by, the operating system.
<%BOLD%>sfaDirectory<%BOLD0%>	The "file or directory" is a directory.
<%BOLD%>sfaArchive<%BOLD0%>	The file or directory is an archive file or \
directory. Applications use this flag to mark files for backup or removal.
<%BOLD%>sfaNormal<%BOLD0%>	The file or directory has no other attributes set. \
This attribute is valid only if used alone.
<%BOLD%>sfaTemporary<%BOLD0%>	The file is being used for temporary storage. \
File systems attempt to keep all of the data in memory for quicker access \
rather than flushing the data back to mass storage. A temporary file should be \
deleted by the application as soon as it is no longer needed.
<%BOLD%>sfaCompressed<%BOLD0%>	The file or directory is compressed. For a \
file, this means that all of the data in the file is compressed. For a \
directory, this means that compression is the default for newly created files \
and subdirectories.
<%BOLD%>sfaOffline<%BOLD0%>	The data of the file is not immediately available. \
Indicates that the file data has been physically moved to offline storage.
<%ENDTABLE%>

<%SEEALSO GetFileInformation%>

<%EXAMPLE%>
<%TEXT%>
This example retrieves the image index for a file or directory that does \
exist.  For example, if you were populating a listview with the files in a \
directory on the user's system, this would be appropriate.
<%CODE%>
  function AddListItem(const ARealFilename: string);
  var
    Item: TListItem;
    s: string;
  begin
    SomeListView.Items.BeginUpdate;
    try
      Item := SomeListView.Items.Add;
      // ARealFilename must have full path information
      Item.Caption := ExtractFileName(ARealFileName);
      // The filename is real, so let the system figure out the attributes.
      Item.ImageIndex := SomeSystemImageList.GetImageIndex(ARealFilename, []);
    finally
      SomeListView.Items.EndUpdate;
    end;
  end;

<%TEXT%>
This example retrieves the image index for a file type based on it's \
extension. This is appropriate for if you had a listview that was to be filled \
with filenames that did not exist; a zip file viewer or the files on an FTP \
server, for example.
<%CODE%>
  function AddListItem(const AFakeFilename: string, IsADirectory: boolean);
  var
    Item: TListItem;
    s: string;
    Attrs: TSystemFileAttributes;
  begin
    SomeListView.Items.BeginUpdate;
    try
      Item := SomeListView.Items.Add;
      // AFakeFilename does not exist, we must supply the attributes.
      if IsADirectory then
        Attrs := [sfaDirectory] // tell it we want the folder image index.
      else
        Attrs := [sfaNormal]; // figure it out based on file extension.
      Item.ImageIndex := SomeSystemImageList.GetImageIndex(AFakeFilename, Attrs);
    finally
      SomeListView.Items.EndUpdate;
    end;
  end;
}
{CE_Desc_End}
    {$IFDEF DFS_COMPILER_4_UP}
    function GetImageIndex(const APath: string; Selected, Open: boolean;
       Attrs: TSystemFileAttributes): integer; overload;
    function GetImageIndex(const APidl: PItemIDList; Selected,
       Open: boolean ): integer; overload;
    function GetImageIndex(SpecialItem: TShellItem; Selected,
       Open: boolean): integer; overload;
    {$ELSE}
    function GetImageIndex(const APath: string; Selected, Open: boolean;
       Attrs: TSystemFileAttributes): integer;
    function GetImageIndexPIDL(const APidl: PItemIDList; Selected,
       Open: boolean): integer;
    function GetImageIndexSpecial(SpecialItem: TShellItem; Selected,
       Open: boolean): integer;
    {$ENDIF}

{CE_Desc_Begin(TdfsSystemImageList.GetFileInformation)}
{The <%BOLD%>GetFileInformation<%BOLD0%> method is identical to the \
<%BOLD%><%LINK GetImageIndex%><%BOLD0%> method with the exception that it also \
retrieves the system description text for the file type.  This text is what \
you see in the <%BOLD%>Type<%BOLD0%> column of Explorer.

Simply pass a string variable in the <%BOLD%>Descr<%BOLD0%> parameter and it \
will be assigned the system description text.

All other aspects of this method are identical to <%BOLD%>GetImageIndex<%BOLD0%>.

<%SEEALSO GetImageIndex%>
}
{CE_Desc_End}
    {$IFDEF DFS_COMPILER_4_UP}
    function GetFileInformation(const APath: string; Selected, Open: boolean;
       Attrs: TSystemFileAttributes; var Descr: string): integer; overload;
    function GetFileInformation(const APidl: PItemIDList; Selected, Open: boolean;
       Attrs: TSystemFileAttributes; var Descr: string): integer; overload;
    function GetFileInformation(SpecialItem: TShellItem; Selected, Open: boolean;
       Attrs: TSystemFileAttributes; var Descr: string): integer; overload;
    {$ELSE}
    function GetFileInformation(const APath: string; Selected, Open: boolean;
       Attrs: TSystemFileAttributes; var Descr: string): integer;
    function GetFileInformationPIDL(const APidl: PItemIDList; Selected, Open: boolean;
       Attrs: TSystemFileAttributes; var Descr: string): integer;
    function GetFileInformationSpecial(SpecialItem: TShellItem; Selected, Open: boolean;
       Attrs: TSystemFileAttributes; var Descr: string): integer;
    {$ENDIF}



{CE_Desc_Begin(TdfsSystemImageList.Handle)}
{The <%BOLD%>Handle<%BOLD0%> property is the Win32 handle of the image list in \
use.  If the <%BOLD%><%LINK ShareImages%><%BOLD0%> property is TRUE, the \
handle is the <%BOLD%>REAL<%BOLD0%> system image list.  That means any changes \
to it will affect the <%ITALIC%><%BOLD%>entire system<%BOLD0%><%ITALIC0%>.  If \
<%BOLD%>ShareImages<%BOLD0%> is FALSE, the component has made a copy of the \
system image list and changes will affect only the component.

<%SEEALSO ShareImages%>
}
{CE_Desc_End}
    property Handle: HImageList { read only! }
       read GetHandle;
  published
{CE_Desc_Begin(TdfsSystemImageList.Version)}
{Displays the version number of the component.  This allows you to easily \
compare the version installed with the version you *think* you are using.

The property editor for this property also displays the address to my web site \
where you can find the most current version of this component, along with many \