Einzelnen Beitrag anzeigen

Benutzerbild von Matze
Matze
(Co-Admin)

Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.929 Beiträge
 
Turbo Delphi für Win32
 
#1

Überprüfen, ob Icons in einer bestimmten Auflösung vorliegen

  Alt 8. Mär 2007, 07: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')
  Mit Zitat antworten Zitat