systemimagelist.pas

动态提示控件

other freeware components written by myself and others.}
{CE_Desc_End}
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
{CE_Desc_Begin(TdfsSystemImageList.ImageSize)}
{<%BOLD%>ImageSize<%BOLD0%> indicates what size image is to be provided by the \
component.

Possible values are:
<%TABLE%><%BOLD%>isLarge<%BOLD0%>	The large image list is most commonly used \
for list view controls with ViewStyle set to vsIcon.
<%BOLD%>isSmall<%BOLD0%>	The small image list is most commonly used for list \
view controls with ViewStyle set to a value other than vsIcon, and also tree \
view controls.
<%ENDTABLE%>
If you need to determine the exact size of either large or small images in the \
list, use the <%BOLD%><%LINK Height%><%BOLD0%> and <%BOLD%><%LINK Width%> \
<%BOLD0%> properties.

<%SEEALSO Height, Width%>
}
{CE_Desc_End}
    property ImageSize: TImageSize
       read FImageSize
       write SetImageSize
       default isLarge;
{CE_Desc_Begin(TdfsSystemImageList.Height)}
{The <%BOLD%>Height<%BOLD0%> property is used to report the height of the \
images contained in the list.  You can not directly change this value since \
it is dictated by the system.  To change the size of images in the list, use \
the <%BOLD%><%LINK ImageSize%><%BOLD0%> property.

<%SEEALSO Width, ImageSize%>
}
{CE_Desc_End}
    property Height: integer
       read GetHeight { read only! }
       stored FALSE;
{CE_Desc_Begin(TdfsSystemImageList.Width)}
{The <%BOLD%>Width<%BOLD0%> property is used to report the width of the \
images contained in the list.  You can not directly change this value since \
it is dictated by the system.  To change the size of images in the list, use \
the <%BOLD%><%LINK ImageSize%><%BOLD0%> property.

<%SEEALSO Height, ImageSize%>
}
{CE_Desc_End}
    property Width: integer
       read GetWidth { read only! }
       stored FALSE;
{CE_Desc_Begin(TdfsSystemImageList.ShareImages)}
{The <%BOLD%>ShareImages<%BOLD0%> property is used to indicate whether the \
component should use the <%BOLD%>real<%BOLD0%> system image list or make a \
copy of it for the components used.

Using the real system image list means any changes made to it will affect the \
<%ITALIC%><%BOLD%>entire system<%BOLD0%><%ITALIC0%> until it is restarted.

<%NOTE%>For safety reasons, you should always set <%BOLD%>ShareImages<%BOLD0%> \
to TRUE when it is possible.  The drawback to doing this is that it can be \
quite time consuming to make the initial copy of the system's image list (it \
can be very large, upwards of several megabytes).

<%SEEALSO Handle%>
}
{CE_Desc_End}
    property ShareImages: boolean
       read GetShareImages
       write SetShareImages
       nodefault;
  end;


{CE_Desc_Begin(GeTdfsSystemImageList)}
{<%BOLD%>GeTdfsSystemImageList<%BOLD0%> is a function that is can be used to get \
the handle of the system's large and small image list.  This list is \
<%BOLD%>owned by the system<%BOLD0%>.  It is <%BOLD%>NOT<%BOLD0%> a copy.

The <%BOLD%>Large<%BOLD0%> parameter indicates whether to return the image \
list handle that contains large or small icons.

You should <%ITALIC%><%BOLD%>never<%BOLD0%><%ITALIC0%> free this handle when \
you are done with it.  Doing so will leave the entire OS without an image \
list.  Explorer looks damn funny that way.}
{CE_Desc_End}
function GeTdfsSystemImageList(Large: boolean): HImageList;

{CE_Desc_Begin(GetIconIndex)}
{Retrieves the index into the system image list of a file or directory item. \
If the item does not exist, the <%BOLD%>Attrs<%BOLD0%> parameter is used to \
describe its attributes. If the file does exist, <%BOLD%>Attrs<%BOLD0%> is \
ignored.

The <%BOLD%>Attrs<%BOLD0%> parameter accepts any of the \
<%BOLD%>FILE_ATTRIBUTE_xxx<%BOLD0%> constants ORed together bitwise, or 0 if \
the system should determine the attributes itself.  You can find a list of \
these constants in the Win32.hlp file under the \
<%BOLD%>GetFileAttributes<%BOLD0%> topic.

<%SEEALSO GetFileInfo%>
<%EXAMPLE%>
<%TEXT%>
If you wanted to get the index of a file, say c:\windows\notepad.exe, that did \
exist, you would call it like this:
<%CODE%>
  Index := GetIconIndex('c:\windows\notepad.exe', 0);

<%TEXT%>
If you wanted to get the index for a file that did not exist, you would need \
to specify what file attributes should be used in determining the image index.
<%CODE%>
  Index := GetIconIndex('c:\bogus\dir\badfile.html', FILE_ATTRIBUTE_NORMAL);
}
{CE_Desc_End}
{$IFDEF DFS_COMPILER_4_UP}
function GetIconIndex(const APath: string; Selected, Open: boolean;
  Attrs: DWORD; AlwaysUseAttrs: boolean): integer; overload;
function GetIconIndex(const APidl: PItemIDList; Selected,
  Open: boolean): integer; overload;
function GetIconIndex(SpecialItem: TShellItem; Selected,
  Open: boolean): integer; overload;
{$ELSE}
function GetIconIndex(const APath: string; Selected, Open: boolean;
  Attrs: DWORD; AlwaysUseAttrs: boolean): integer;
function GetIconIndexPIDL(const APidl: PItemIDList; Selected,
  Open: boolean): integer;
function GetIconIndexSpecial(SpecialItem: TShellItem; Selected,
  Open: boolean): integer;
{$ENDIF}

{CE_Desc_Begin(GetFileInfo)}
{This function is exactly the same as <%BOLD%><%LINK GetIconIndex%><%BOLD0%> \
except that it takes an extra variable parameter that is assigned the system \
description for the file.  The contents of this string parameter does not \
matter when the function is called, it is used strictly for output.

<%SEEALSO GetIconIndex%>
}
{CE_Desc_End}
{$IFDEF DFS_COMPILER_4_UP}
function GetFileInfo(const APath: string; Selected, Open: boolean; Attrs: DWORD;
   AlwaysUseAttrs: boolean; var Descr: string): integer; overload;
function GetFileInfo(const APidl: PItemIDList; Selected, Open: boolean; Attrs: DWORD;
   AlwaysUseAttrs: boolean; var Descr: string): integer; overload;
function GetFileInfo(SpecialItem: TShellItem; Selected, Open: boolean; Attrs: DWORD;
   AlwaysUseAttrs: boolean; var Descr: string): integer; overload;
{$ELSE}
function GetFileInfo(const APath: string; Selected, Open: boolean; Attrs: DWORD;
   AlwaysUseAttrs: boolean; var Descr: string): integer;
function GetFileInfoPIDL(const APidl: PItemIDList; Selected, Open: boolean;
   Attrs: DWORD; AlwaysUseAttrs: boolean; var Descr: string): integer;
function GetFileInfoSpecial(SpecialItem: TShellItem; Selected, Open: boolean;
   Attrs: DWORD; AlwaysUseAttrs: boolean; var Descr: string): integer;
{$ENDIF}


implementation


uses
  ShellAPI,
  {$IFDEF DFS_COMPILER_3_UP} ActiveX, {$ELSE} OLE2, {$ENDIF}
  FileCtrl;


// I'll get to it in a minute, now shut up compiler.
function SFA2API(Attrs: TSystemFileAttributes): DWORD; forward;
function GetValidHandle(ImgList: TdfsSystemImageList): HWND; forward;


constructor TdfsSystemImageList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImageSize := isLarge;
  ShareImages := TRUE;
end;

procedure TdfsSystemImageList.SetName(const NewName: TComponentName);
begin
  inherited SetName(NewName);
  // I really couldn't give a flying doughnut about SetName, I just needed
  // something I could override that would happen when the component was being
  // created dynamically so I could create the handle.  In a windowed component,
  // I could override CreateWnd which would make sense, but this little freak
  // doesn't make it's CreateHandle virtual.  Matter of fact, it makes damn
  // little of itself virtual, making my life a lot harder than it should be.
  // Can you tell I'm really ticked off at the moment?

  // If it isn't loading, create the handle.  If it is, wait until all
  // properties have been loaded before doing it so we don't have to recreate
  // it every time one changes.
  if not (csLoading in ComponentState) then
    SetImageListHandle(ShareImages);
end;

procedure TdfsSystemImageList.Loaded;
begin
  inherited Loaded;
  SetImageListHandle(ShareImages);
end;

procedure TdfsSystemImageList.WriteState(Writer: TWriter);
var
  TempHandle: HImageList;
begin
  // We don't want the system image list being streamed out to disk.  It is
  // like a couple of meg in size.
  TempHandle := Handle;
  inherited Handle := 0;
  inherited WriteState(Writer);
  inherited Handle := TempHandle;
end;

procedure TdfsSystemImageList.SetImageListHandle(Shared: boolean);
var
  TempHandle: HImageList;
  TempList: TImageList;
  OldCursor: TCursor;
begin
  { if we have a handle already, this will get rid of it according to
    ShareImages property }
  inherited Handle := 0;

  TempHandle := GeTdfsSystemImageList(FImageSize = isLarge);
  if Shared then
    // give them the real thing
    inherited Handle := TempHandle
  else begin
    // make a copy of it.  This can be quite slow.
    TempList := TImageList.Create(Self);
    OldCursor := Screen.Cursor;
    Screen.Cursor := crHourglass;
    try
      TempList.ShareImages := TRUE;
      TempList.Handle := TempHandle;
      Assign(TempList);
    finally
      Screen.Cursor := OldCursor;
      TempList.Free;
    end;
  end;
end;

procedure TdfsSystemImageList.SetImageSize(Val: TImageSize);
begin
  if FImageSize <> Val then
  begin
    FImageSize := Val;
    if HandleAllocated then
      SetImageListHandle(ShareImages);
  end;
end;

function TdfsSystemImageList.GetHeight: integer;
begin
  Result := inherited Height;
end;

function TdfsSystemImageList.GetWidth: integer;
begin
  Result := inherited Width;
end;

function TdfsSystemImageList.GetShareImages: boolean;
begin
  Result := inherited ShareImages;
end;

procedure TdfsSystemImageList.SetShareImages(Val: boolean);
begin
  if HandleAllocated then
    SetImageListHandle(Val);
  inherited ShareImages := Val;
end;

function TdfsSystemImageList.GetHandle: HImageList;
begin
  if not HandleAllocated then
    SetImageListHandle(ShareImages);
  Result := inherited Handle;
end;

// Only need Attrs if APath doesn't exist, otherwise just pass []
function TdfsSystemImageList.GetImageIndex(const APath: string; Selected,
   Open: boolean; Attrs: TSystemFileAttributes): integer;
begin
  Result := GetIconIndex(APath, Selected, Open, SFA2API(Attrs), Attrs <> []);
end;

{$IFDEF DFS_COMPILER_4_UP}
function TdfsSystemImageList.GetImageIndex(const APidl: PItemIDList;
   Selected, Open: boolean): integer;
begin
  Result := GetIconIndex(APidl, Selected, Open);
end;
{$ELSE}
function TdfsSystemImageList.GetImageIndexPIDL(const APidl: PItemIDList;
   Selected, Open: boolean): integer;
begin
  Result := GetIconIndexPIDL(APidl, Selected, Open);
end;
{$ENDIF}

{$IFDEF DFS_COMPILER_4_UP}
function TdfsSystemImageList.GetImageIndex(SpecialItem: TShellItem;
   Selected, Open: boolean): integer;
begin
  Result := GetIconIndex(SpecialItem, Selected, Open);
end;
{$ELSE}
function TdfsSystemImageList.GetImageIndexSpecial(SpecialItem: TShellItem;
   Selected, Open: boolean): integer;
begin
  Result := GetIconIndexSpecial(SpecialItem, Selected, Open);
end;
{$ENDIF}


// Only need Attrs if APath doesn't exist, otherwise just pass []
function TdfsSystemImageList.GetFileInformation(const APath: string;
   Selected, Open: boolean; Attrs: TSystemFileAttributes;
   var Descr: string): integer;
begin
  Result := GetFileInfo(APath, Selected, Open, SFA2API(Attrs), Attrs <> [], Descr);