Delphi-PRAXiS - Delphi Vista Icons extrahieren und als PNG speichern...

So habe jetzt lange, lange gesucht und getüftelt und diesen Code zu Stande bekommen.
Den wollt ich euch nicht vorenthalten... Mit der ICO zu PNG Sache habe ich noch so meine Probleme was die Transparenz anbetrifft, vielleicht fällt ja jemandem von euch dazu was ein? :-)

Hab den so gut es ging kommentiert, hoffe der ist vorzeigbar:

Unit: ExtractVistaIcon

Delphi-Quellcode:

			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.

Erläuterung:

Delphi-Quellcode:

			function ExtractIconVista(

IconLocation: string; //Der Pfad zur Bibliothek (exe oder dll)

out HandleIconOut: HIcon; //Das Handle des Icons wird hier abgelegt

IconNum: Integer=0; //Die Nummer der Icon Gruppe in der Bibliothek: 0 = Erstes Icon; -1 = Letztes Icon

IconNumAsIndex: Boolean=False; //Wenn IconNumAsIndex = True wird IconNum als Index der Icon-Group betrachtet und die Bibliothek wird nicht nach Icon-Gruppen durchforstet

cxDesired: Cardinal = 0; //Die gewünschte Breite des Icons

cyDesired: Cardinal = 0; //Die gewünschte Höhe des Icons

Flags: Dword = 0 //Die folgenden Werte sind gültig: {

 LR_DEFAULTCOLOR = $0000;

  LR_MONOCHROME = $0001;

  LR_COLOR = $0002;

  LR_COPYRETURNORG = $0004;

  LR_COPYDELETEORG = $0008;

  LR_LOADFROMFILE = $0010;

  LR_LOADTRANSPARENT = $0020;

  LR_DEFAULTSIZE = $0040;

  LR_VGACOLOR = $0080;

  LR_LOADMAP3DCOLORS = $1000;

  LR_CREATEDIBSECTION = $2000;

  LR_COPYFROMRESOURCE = $4000;

  LR_SHARED = $8000;

}

): Boolean; //Erfolg der Funktion: True wenn das Icon erfolgreich extrahiert wurde, False wenn etwas schief gegangen ist...

Anwendungsbeispiel:

Delphi-Quellcode:

			procedure TForm1.BitBtn1Click(Sender: TObject);

var

IconLocation: string;

ErgebnisIcon: TIcon;

ErgebnisIconH: hIcon;

begin

IconLocation:='C:\Program Files\Test\Test.exe';

ErgebnisIcon:=TIcon.Create;

ExtractIconVista(IconLocation,ErgebnisIconH,0,False,256,256,LR_VGACOLOR);

ErgebnisIcon.Handle:=ErgebnisIconH;

Form1.Canvas.Draw(0,0,ErgebnisIcon);

ErgebnisIcon.Free;

end;

Wie oben erwähnt: wenn jemand eine Idee zur Konvertierung ins PNG-Format hat (mit Alpha-Kanal), her damit :-)