AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Grafik / Sound / Multimedia Delphi Überprüfen, ob Icons in einer bestimmten Auflösung vorliegen
Thema durchsuchen
Ansicht
Themen-Optionen

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

Ein Thema von Matze · begonnen am 8. Mär 2007
Antwort Antwort
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
Antwort Antwort

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:12 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz