(Co-Admin)
Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.929 Beiträge
Turbo Delphi für Win32
|
Überprüfen, ob Icons in einer bestimmten Auflösung vorliegen
8. Mär 2007, 08:32
bitsetter zeigt in diesem Beitrag, wie es möglich ist, herauszufinden, ob sich in *.ico-Dateien oder in Dateien mit Resourcen (*.exe, *.dll) Icons in bestimmten Auflösungen befinden.
Delphi-Quellcode:
type
TResID = record
ResInt: integer;
ResString: AnsiString;
isInteger: boolean;
end;
type
PResID = ^TResID;
function EnumResIcon(Module: THandle; resType: PChar; HasIconGroup: PBool): bool; stdcall;
begin
if resType = RT_GROUP_ICON then
begin
HasIconGroup^ := true;
result := false;
end
else
result := true;
end;
function EnumIconNames(Module: THandle; ResType, ResName: PChar; ResID: PResID): bool; stdcall;
begin
if integer(resName) < $FFFF then
begin
ResID^.ResInt := integer(ResName);
ResID^.isInteger := true;
end
else
begin
SetString(ResID^.ResString, ResName, Length(ResName));
ResID^.isInteger := false;
end;
result := false;
end;
function HasIcoSize(IconPfad: AnsiString; IconSize: Byte): boolean;
var
IconNr, IconAnzahl: byte;
Next: cardinal;
IconStream: TFileStream;
ResStream: TResourceStream;
Buffer: array of byte;
FileExt: AnsiString;
Lib: THandle;
HasIcons: LongBool;
ResID: TResID;
begin
result := false;
if FileExists(IconPfad) then
begin
FileExt := UpperCase(ExtractFileExt(IconPfad));
if (FileExt = '.ICO') or (FileExt = '.CUR') then
begin
IconStream := TFileStream.Create(IconPfad, fmOpenRead);
try
if IconStream.Seek(4, soFromCurrent) = 4 then
if IconStream.Read(IconAnzahl, 1) = 1 then
if IconStream.Seek(0, soFromBeginning) = 0 then
begin
Next := 6;
setlength(Buffer, IconAnzahl * 16);
if IconStream.Read(Buffer[0], length(Buffer)) = Length(Buffer) then
for IconNr := 1 to IconAnzahl do
begin
if (Buffer[Next] = IconSize) and (Buffer[Next + 1] = IconSize) then
begin
result := true;
break;
end;
inc(Next, 16);
end;
end;
finally
IconStream.Free;
end;
end
else
begin
Lib := LoadLibraryEx(PChar(IconPfad), 0, LOAD_LIBRARY_AS_DATAFILE);
if Lib <> 0 then
try
HasIcons := false;
EnumResourceTypes(Lib, @EnumResIcon, integer(@HasIcons));
if HasIcons then
begin
EnumResourceNames(Lib, RT_GROUP_ICON, @EnumIconNames, integer(@ResID));
if ResID.isInteger then
ResStream := TResourceStream.CreateFromID(Lib, ResID.ResInt, RT_GROUP_ICON)
else
ResStream := TResourceStream.Create(Lib, ResID.ResString, RT_GROUP_ICON);
try
IconAnzahl := byte(pointer(cardinal(ResStream.Memory) + 4)^);
Next := 6;
for IconNr := 1 to IconAnzahl do
begin
if (byte(pointer(cardinal(ResStream.Memory)+ Next)^) = IconSize) and
(byte(pointer(cardinal(ResStream.Memory)+ Next+ 1)^) = IconSize) then
begin
result := true;
break;
end;
inc(Next, 14);
end;
finally
ResStream.Free;
end;
end;
finally
windows.FreeLibrary(Lib);
end;
end;
end;
end;
Ein Beispielaufruf könnte so aussehen:
Delphi-Quellcode:
if OpenDialog1.execute then
if HasIcoSize(OpenDialog1.FileName, 48)then
Showmessage('Die Datei hat Icone mit mit einer Größe von 48 X 48')
else
Showmessage('Die Datei hat KEINE Icone mit mit einer Größe von 48 X 48')
|
|
Zitat
|