unit ExtractVistaIcon;
interface
uses Windows, Dialogs, SysUtils;
function ExtractIconVista(IconLocation:
string;
out HandleIconOut: HIcon; IconNum: Integer=0; IconNumAsIndex: Boolean=False; cxDesired: Cardinal = 0; cyDesired: Cardinal = 0; Flags: Dword = 0): Boolean;
implementation
//Diese Funktion ist in der Standard-Windows Unit nicht enthalten:
function IS_INTRESOURCE(lpszType: PChar): Boolean;
begin
Result := ((DWORD(lpszType)
shr 16) = 0);
end;
//------------------------------------------------------------------------------
var
IconsFound: Integer;
LastResNum: Integer;
LastResName:
string;
//Die Callback-Funktion für EnumResourceNames
function EnumIcon(Module: THandle; ResType: PChar; ResName: PChar; Param: Pointer): Bool;
export;
stdcall;
begin
//Die letzten Einträge überschreiben
LastResNum:=-1;
LastResName:='
';
//Überprüfen ob ResName eine ID (dann in LastResNum speichern) oder ein Name ist
if IS_INTRESOURCE(ResName)
then LastResNum:=Integer(ResName)
else LastResName:=string(ResName);
//Die Bibliothek so lange durchlaufen bis IconIndex erreicht ist
if IconsFound = Integer(Param)
then
Result:=False
else
Result:=True;
Inc(IconsFound);
end;
//------------------------------------------------------------------------------
function ExtractIconVista(IconLocation:
string;
out HandleIconOut: HIcon; IconNum: Integer=0; IconNumAsIndex: Boolean=False; cxDesired: Cardinal = 0; cyDesired: Cardinal = 0; Flags: Dword = 0): Boolean;
var
hLib,hRes,lRes,hResIcon,lResIcon: Cardinal;
MRes: PAnsiChar;
lIcon: Integer;
begin
Result:=False;
//Die Bibliothek laden, welche das Icon enthält (exe oder dll)
hLib:=LoadLibraryEx(PChar(IconLocation), 0, LOAD_LIBRARY_AS_DATAFILE);
if hLib <> 0
then
try
IconsFound:=0;
//Wenn IconNum nicht Index der Icon-Group ist, dann durchlaufe Bibliothek
if IconNumAsIndex=False
then
//Die Bibliothek nach Icon-Groups durchsuchen und beim ersten Fund anhalten
EnumResourceNames(hLib, RT_GROUP_ICON, @EnumIcon, IconNum)
else
//Wenn IconNum Index der Icon-Group ist, dann verwende IconNum als LastResNum
LastResNum:=IconNum;
//Ein Handle auf die gefundene Icon-Group Resource bekommen
if LastResNum=-1
then
hRes:=FindResource(hLib, PChar(LastResName), RT_GROUP_ICON)
else
hRes:=FindResource(hLib, MakeIntResource(LastResNum) , RT_GROUP_ICON);
if hRes <> 0
then try
//Die Resource laden
lRes:=LoadResource(hLib, hRes);
if lRes <> 0
then try
if cxDesired+cyDesired<=1
then
//Wenn die gewünschte Icongröße nicht angegeben ist, nach dem Icon suchen, das am besten für das Anzeigegerät geeignet ist
lIcon:=LookupIconIDFromDirectory(LockResource(lRes), True)
else
//Andernfalls, nach dem Icon suchen, das am besten zu den Angaben passt
lIcon:=LookupIconIDFromDirectoryEx(LockResource(lRes), True, cxDesired,cyDesired,Flags);
//In RC-Wert konvertieren
MRes:=MakeIntResource(lIcon);
//Ein Handle auf die gefundene Icon Resource bekommen
if lIcon <> 0
then begin hResIcon := FindResource(hLib, MRes, RT_ICON);
if hResIcon <> 0
then try
//Die Icon Resource laden
lResIcon := LoadResource(hLib, hResIcon);
if lResIcon <> 0
then try
//Das Icon aus der Resource erstellen
HandleIconOut:=CreateIconFromResourceEx(LockResource(lResIcon),
SizeOfResource(hLib, hResIcon),
True, $030000, cxDesired, cyDesired, Flags);
Result:=True;
finally
UnLockResource(lResIcon);
end;
finally
FreeResource(hResIcon);
end;
end;
finally
UnlockResource(lRes);
end;
finally
FreeResource(hRes);
end;
finally
FreeLibrary(hLib);
end;
end;
end.