unit ShellIcons;
interface
uses
SysUtils, Classes, CommCtrl, Controls, Windows, ShellAPI;
type
TShellIcons =
class(TComponent)
private
FBigIcons: TImageList;
FSMallIcons: TImageList;
{ Private-Deklarationen }
protected
{ Protected-Deklarationen }
public
property BigIcons: TImageList
read FBigIcons;
property SmallIcons: TImageList
read FSMallIcons;
// '' steht für Ordner Dateierweiterungen müssen mit . angegeben werden
function GetFileType(
const Extension:
String):
String;
function GetImageIndex(
const Extension:
String;
const Opened: Boolean): Integer;
procedure RefreshShellIcons;
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
{ Public-Deklarationen }
published
{ Published-Deklarationen }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Beispiele', [TShellIcons]);
end;
{ TShellIcons }
constructor TShellIcons.Create(AOwner: TComponent);
begin
inherited;
FBigIcons := TImageList.Create(Self);
FBigIcons.ShareImages := True;
FSmallIcons := TImageList.Create(Self);
FSMallIcons.ShareImages := True;
RefreshShellIcons;
end;
destructor TShellIcons.Destroy;
begin
FBigIcons.Free;
FSmallIcons.Free;
inherited;
end;
function TShellIcons.GetFileType(
const Extension:
String):
String;
var
FileInfo: TSHFileInfo;
FAttr, Attr: Cardinal;
begin
ZeroMemory(@FileInfo, SizeOf(FileInfo));
//SHGFI_SMALLICON oder _LARGEICON hat keinen Einfluss auf FileInfo.iIcon >> haben immer den selben Index
Attr := SHGFI_TYPENAME
or SHGFI_USEFILEATTRIBUTES;
if Extension = '
'
then
FAttr := FILE_ATTRIBUTE_DIRECTORY
else
FAttr := FILE_ATTRIBUTE_NORMAL;
ShGetFileInfo(PChar(Extension), FAttr, FileInfo, SizeOf(TSHFileInfo), Attr);
Result := FileInfo.szTypeName;
end;
function TShellIcons.GetImageIndex(
const Extension:
String;
const Opened: Boolean): Integer;
var
FileInfo: TSHFileInfo;
FAttr, Attr: Cardinal;
begin
ZeroMemory(@FileInfo, SizeOf(FileInfo));
//SHGFI_SMALLICON oder _LARGEICON hat keinen Einfluss auf FileInfo.iIcon >> haben immer den selben Index
Attr := SHGFI_ICON
or SHGFI_SYSICONINDEX
or SHGFI_USEFILEATTRIBUTES
or SHGFI_TYPENAME;
if Opened
then
Attr := Attr
or SHGFI_OPENICON;
if Extension = '
'
then
FAttr := FILE_ATTRIBUTE_DIRECTORY
else
FAttr := FILE_ATTRIBUTE_NORMAL;
ShGetFileInfo(PChar(Extension), FAttr, FileInfo, SizeOf(TSHFileInfo), Attr);
Result := FileInfo.iIcon;
end;
procedure TShellIcons.RefreshShellIcons;
var
FileInfo: TSHFileInfo;
HBigList, HSmallList: HImageList;
begin
ZeroMemory(@FileInfo, SizeOf(FileInfo));
HSmallList := HImageList(SHGetFileInfo('
', FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX
or SHGFI_SMALLICON));
if HSmallList <> 0
then
FSMallIcons.Handle := HSmallList;
HBigList := HImageList(SHGetFileInfo('
', FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX
or SHGFI_LARGEICON));
if HBigList <> 0
then
FBigIcons.Handle := HBigList;
end;
end.