Voila j'espère qu'il n’y a pas de bug.
Je vous fait confiance pour les trouver.Fonctionnement: Un clique sur le treeGadget indique le chemin pour l'extraction. Si vous cliquez sur ce PC ce sera tous les lecteurs valides de votre PC qui sera scanné a la recherche des icônes
selon les machines cela prend plus ou moins de temps. (fichiers Dll.Exe.Icl,Ico)
Sélectionnez une icône par un clique dans la liste.Vous pouvez ensuite le transféré dans un dossier de votre choix pour un traitement de votre choix. Pour cela un clique sur le bouton transfert fera l'affaire. Vous avez bien entendus le possibilité de changer le nom de l'icône.
Ce logiciel n'a aucune prétention, mais pour un nul en dessins comme moi c'est très utile.
Le code est libre faite en ce que vous voulez. Remonter moi les critiques (seulement si elles sont constructives)
Amuser vous bien
Michel
Code : Tout sélectionner
;MLD EXTACTEUR D'ICONES 03/10/2017
;PB 5.60 X86.
;code libre.
;Merçi principalement a Zorro,indirectement a SROD pour la procedure SaveIcon(hIcon, filename$),et a tous autres pour leur aide
;***constantes***
#fenpr =0:#eticpres = 1:#eticexp1 = 2:#eticexp2 = 3:#eticexp3 = 4:#eticexp4 = 5:#eticexp5 = 6
#explorer = 10:#cadre1 = 11:#cadre2 = 12:#cadre3 = 13:#cadre4 = 14
#text1 = 20:#coche1 = 23:#coche2 = 24:#listico = 25:#conteneur = 26:#gadimg = 27
#bttrans = 30:#btbdt = 31:#btok = 32:btstop = 33
#txtinfofich1 = 40:#txtinfonbico3 = 41:#txtfich = 42:#txtnbico = 43:#txt_attente = 44
;******* fenetre secondaire *********
#fens = 100:#eticpresfs = 101:#eticexpfs1 = 102:#eticexpfs2 = 103:#eticexpfs3 = 104:#eticexpfs4 = 105
#explorerfs = 117:#gadimgfs = 118:#stringfs = 119:#stringfs2 = 120:#btokfs = 130:#btstopfs = 131
Global FontID1 = LoadFont(50,"Tahoma",14,#PB_Font_Bold)
Global FontID2 = LoadFont(51,"Tahoma",12,#PB_Font_HighQuality)
Global FontID3 = LoadFont(52,"Segoe Print",16,#PB_Font_HighQuality)
Global FontID4 = LoadFont(53,"Tahoma",8,#PB_Font_HighQuality)
Global FontID5 = LoadFont(54,"Segoe Print",32,#PB_Font_HighQuality)
Global nbf.f
Global nbico.q,flagico.b =1
Global Dim tabicochem.s(0)
Macro couletic(gad)
SetGadgetFont(gad,FontID3)
SetGadgetColor(gad,#PB_Gadget_FrontColor,$8515C7)
SetGadgetColor(gad,#PB_Gadget_BackColor,$DCE4DC)
EndMacro
Macro couletic2(gad)
SetGadgetFont(gad,FontID3)
SetGadgetColor(gad,#PB_Gadget_FrontColor,$00FFFF)
SetGadgetColor(gad,#PB_Gadget_BackColor,$B6AA8C)
EndMacro
Procedure WindowProc(hWnd, msg, wParam, lParam)
If msg=#WM_CTLCOLORSTATIC
Select GetDlgCtrlID_(lParam)
Case 23 To 24
ProcedureReturn CreateSolidBrush_($DCE4DC)
EndSelect
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure Listico(fich$)
Protected j, icon,nbi.q
nbi.q = ExtractIconEx_(fich$, -1, #Null, #Null, #Null) - 1
If nbi <> -1
For j = 0 To nbi.q
If GetGadgetState(23)
z = ExtractIconEx_(fich$, j, #Null, @icon, 1) ;16x16
Else
z = ExtractIconEx_(fich$, j, @icon, #Null, 1) ;32x32
EndIf
If z <> 0
nbico = nbico +1
ReDim tabicochem.s(nbico)
tabicochem.s(nbico)= fich$ +"," + Str(j)
AddGadgetItem(25,-1,Str(CountGadgetItems(25)+1), icon)
EndIf
DestroyIcon_(icon)
Next
EndIf
EndProcedure
Structure InfoSDirectory
SubDirectories.i
Files.i
EndStructure
Define Info.InfoSDirectory
Procedure rech_ico(fich$, *Info.InfoSDirectory)
nbf = nbf +1
SetGadgetText(42,"F n°:"+ Str(nbf) + " " + fich$ )
Protected Numf.q
Numf.q = ExamineDirectory(#PB_Any, fich$, "*.*")
If Numf.q = 0
a$ = LCase(Right(fich$,3))
Select a$
Case "exe","dll","icl","ico"
Listico( fich$ )
EndSelect
Else
If Numf.q
While NextDirectoryEntry(Numf.q)
If DirectoryEntryName(Numf.q) <> "." And DirectoryEntryName(Numf.q) <> ".."
If DirectoryEntryType(Numf.q) = #PB_DirectoryEntry_File
a$ = LCase(Right(fich$ + "\" + DirectoryEntryName(Numf.q),3))
Select a$
Case "exe","dll","icl","ico"
Listico( fich$ + "\" + DirectoryEntryName(Numf.q))
EndSelect
Else
*Info\SubDirectories + 1
rech_ico(fich$ + "\" + DirectoryEntryName(Numf.q), *Info)
EndIf
EndIf
Wend
FinishDirectory(Numf.q)
EndIf
EndIf
EndProcedure
Procedure cdico()
nbf.f = 0:HideGadget(40,0):HideGadget(42,0):HideGadget(41,1):HideGadget(43,1):HideGadget(25,1):HideGadget(44,0)
ClearGadgetItems(25)
fich$ = GetGadgetText(20)
If fich$ = "Ce PC"
For I = 0 To 12 ; balaye l'alphabet
Lecteur.S = Chr(65 + I) + ":\"
ID = ExamineDirectory(#PB_Any, Lecteur, "*")
If ID
While WindowEvent() : Wend
rech_ico(Lecteur.S,@Info )
FinishDirectory(ID)
EndIf
Next
Else
While WindowEvent() : Wend
rech_ico(fich$,@Info)
EndIf
HideGadget(40,1):HideGadget(42,1):HideGadget(41,0):HideGadget(43,0):HideGadget(25,0):HideGadget(44,1)
SetGadgetText(43,Str(CountGadgetItems(25)))
EndProcedure
Procedure.i SaveIcon(hIcon, filename$)
Protected result, iconinfo.ICONINFO, hbmMask, hbmColor,*bitmapinfo.BITMAPINFO
Protected cbitmap.BITMAP, cwidth, cheight, cbitsperpixel, colorcount, colorplanes
Protected mbitmap.BITMAP, mwidth, mheight
Protected file, imagebytecount, hdc, oldbitmap, mem, bytesinrow, temp
GetIconInfo_(hIcon, iconinfo);infos sur l'icone
;Allouez la mémoire pour une structure BITMAPINFO + une table colorée avec 256 entrées.
*bitmapinfo = AllocateMemory(SizeOf(BITMAPINFO) + SizeOf(RGBQUAD)<<8)
If *bitmapinfo = 0 : ProcedureReturn 0 :EndIf
;Obtenez le masque (and) du bitmap
hbmMask=iconinfo\hbmMask
GetObject_(hbmMask, SizeOf(BITMAP),mbitmap)
mwidth= mbitmap\bmWidth
mheight= mbitmap\bmHeight
;Obtenez la couleur (XOR) du bitmap.
hbmColor=iconinfo\hbmColor
If hbmColor
GetObject_(hbmColor, SizeOf(BITMAP),cbitmap)
cwidth= cbitmap\bmWidth
cheight= cbitmap\bmHeight
cbitsperpixel = cbitmap\bmBitsPixel
If cbitsperpixel = 0 : cbitsperpixel = 1 : EndIf
If cbitsperpixel < 8
colorcount=Pow(2,cbitsperpixel) ;Colorcount = 0 si 8 ou plusieurs bpp.
EndIf
colorplanes=cbitmap\bmplanes
Else ;Monochrome icon.
cwidth= mwidth
cheight= mheight/2
cbitsperpixel = 1
colorcount=2
colorplanes=1
mheight=cheight
EndIf
;Création du fichier.
file=CreateFile(#PB_Any,filename$)
If file
WriteWord(file,0)
WriteWord(file,1)
WriteWord(file,1)
;Structure ICONDIRENTRY de 16 octets, un pour chaque icône.
WriteByte(file, cwidth)
WriteByte(file, cheight)
WriteByte(file, colorcount)
WriteByte(file, 0) ;Reserved.
WriteWord(file, colorplanes) ;Devrait égaler 1, - mais à tout hasard!
WriteWord(file, cbitsperpixel)
WriteLong(file,0) ;PROVISOIRE! NOUS DEVONS RETOURNER QUAND NOUS SAVONS LA QUANTITÉ EXACTE.
WriteLong(file,Loc(file)+4) ;FilePos, où démarrages d'InfoHeader
; Structure BITMAPINFOHEADER de 40 octets
imagebytecount=SizeOf(BITMAPINFOHEADER)
WriteLong(file, imagebytecount)
WriteLong(file, cwidth)
WriteLong(file, cheight+mheight) ;Les hauteurs Combinées de couleur + masquent des images.
WriteWord(file, colorplanes) ;Devrait être a 1, mais à tout hasard!
WriteWord(file, cbitsperpixel)
WriteLong(file, 0) ;Compression.
WriteLong(file, 0) ;Taille d'image. Valable mettre au zéro s'il n'y a aucune compression.
WriteLong(file, 0) ;Unused.
WriteLong(file, 0) ;Unused.
WriteLong(file, 0) ;Unused.
WriteLong(file, 0) ;Unused.
hdc = CreateCompatibleDC_(0)
If hbmColor = 0 ;icon Monochrome
WriteLong(file, #Black)
WriteLong(file, #White)
imagebytecount+SizeOf(rgbquad)*2
ElseIf cbitsperpixel <= 8 ;Includes 1 bit non-monochrome icons.
temp = Pow(2,cbitsperpixel)
bytesinrow = SizeOf(rgbquad)*temp
mem = AllocateMemory(bytesinrow)
oldbitmap=SelectObject_(hdc, hbmColor)
GetDIBColorTable_(hdc, 0, temp, mem)
WriteData(file, mem, bytesinrow) ;écrit la table des couleurs
FreeMemory(mem)
SelectObject_(hdc, oldbitmap)
imagebytecount+bytesinrow
EndIf
bytesinrow = (cwidth*cbitsperpixel+31)/32*4 ;Aligned to a 4-byte boundary.
bytesinrow * cheight
mem = AllocateMemory(bytesinrow)
*bitmapinfo\bmiHeader\biSize=SizeOf(BITMAPINFOHEADER)
*bitmapinfo\bmiHeader\biWidth=cwidth
*bitmapinfo\bmiHeader\biPlanes=colorplanes
*bitmapinfo\bmiHeader\biBitCount=cbitsperpixel
If hbmColor
*bitmapinfo\bmiHeader\biHeight=cheight
GetDIBits_(hdc,hbmColor,0,cheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
Else
*bitmapinfo\bmiHeader\biHeight=2*cheight
GetDIBits_(hdc,hbmMask,0,cheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
EndIf
WriteData(file, mem, bytesinrow)
FreeMemory(mem)
imagebytecount+bytesinrow
bytesinrow = (mwidth+31)/32*4
bytesinrow * mheight
mem=AllocateMemory(bytesinrow)
*bitmapinfo\bmiHeader\biWidth=mwidth
*bitmapinfo\bmiHeader\biPlanes=1
*bitmapinfo\bmiHeader\biBitCount=1
If hbmColor
*bitmapinfo\bmiHeader\biHeight=mheight
GetDIBits_(hdc,hbmMask,0,mheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
Else
*bitmapinfo\bmiHeader\biHeight=2*mheight
GetDIBits_(hdc,hbmMask,mheight,mheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
EndIf
WriteData(file, mem, bytesinrow)
FreeMemory(mem)
imagebytecount+bytesinrow
DeleteDC_(hdc)
FileSeek(file, 14)
WriteLong(file, imagebytecount)
CloseFile(file)
result= 1
Else
result= 0
EndIf
DeleteObject_(hbmMask)
DeleteObject_(hbmColor)
FreeMemory(*bitmapinfo)
ProcedureReturn result
EndProcedure
Procedure selectico(numico.q)
i$ = tabicochem.s(numico+1)
fich$ =StringField(i$,1,",")
j = Val(StringField(i$,2,","))
If GetGadgetState(23)
z = ExtractIconEx_(fich$,j, #Null, @icon, 1) ;16x16
Else
z = ExtractIconEx_(fich$,j, @icon, #Null, 1) ;32x32 EndIf
EndIf
If z <> 0
SetGadgetState(27,icon)
EndIf
EndProcedure
Procedure fs()
hWinForeGround = GetForegroundWindow_()
OpenWindow(100,l,h,800,500,"",#PB_Window_BorderLess | #PB_Window_Invisible)
l = (((WindowX(0)+ WindowWidth(0))- WindowWidth(100))/2) + 200
h= ((WindowY(0)+ WindowHeight(0))-WindowHeight(100))/2
ResizeWindow(100,l,h,#PB_Ignore,#PB_Ignore)
SetClassLongPtr_(WindowID(100),#GCL_STYLE,$00020000)
HideWindow(100,0)
SetWindowColor(100,$B6AA8C)
SetWindowLongPtr_(WindowID(100),#GWL_HWNDPARENT, FindWindow_(0,""))
EnableWindow_(hWinForeGround, #False)
;gadgets
N$ = " TRANSFERT"
For x = 1 To Len(N$)
L$ = L$ + Mid(N$,x,1) + Chr(10)
Next
TextGadget(101,0,0,30,500,L$,#PB_Text_Center)
SetGadgetColor(101,#PB_Gadget_BackColor,$88DC94)
SetGadgetColor(101,#PB_Gadget_FrontColor,$FF7648)
SetGadgetFont(101,FontID1)
TextGadget(102,40,10,100,28,"Cible")
couletic2(102)
TextGadget(103,400,140,100,28,"Icône")
couletic2(103)
TextGadget(104,400,240,200,28,"Nom de l'icône")
couletic2(104)
TextGadget(105,40,440,550,22,"C:\")
SetGadgetColor(105,#PB_Gadget_BackColor,$B6AA8C)
SetGadgetColor(105,#PB_Gadget_FrontColor,$FFFFFF)
SetGadgetFont(105,FontID4)
ExplorerTreeGadget(117,31,50,320,385, "",#PB_Explorer_NoMyDocuments|#PB_Explorer_GridLines|#PB_Explorer_AlwaysShowSelection)
SetGadgetColor(117,#PB_Gadget_BackColor,$B6AA8C)
SetGadgetColor(117,#PB_Gadget_FrontColor,$FFFFFF)
SetGadgetColor(117,#PB_Gadget_LineColor,$FFFFFF)
SetGadgetFont(117,FontID2)
If GetGadgetState(23)
ImageGadget(118,610,152, 35, 35,GetGadgetState(27))
Else
ImageGadget(118,600,142, 35, 35,GetGadgetState(27))
EndIf
StringGadget(119,605,247,100,25,"000",#PB_String_BorderLess)
SetGadgetColor(119,#PB_Gadget_BackColor,$CBBA8C)
SetGadgetColor(119,#PB_Gadget_FrontColor,$FFFFFF)
SetGadgetFont(119,FontID2)
StringGadget(120,710,247,40,25,".ico",#PB_String_BorderLess|#PB_String_ReadOnly)
SetGadgetColor(120,#PB_Gadget_BackColor,$CBBA8C)
SetGadgetColor(120,#PB_Gadget_FrontColor,$FFFFFF)
SetGadgetFont(120,FontID2)
ButtonGadget(130,620,460,80,25,"Transfert")
SetGadgetFont(130,FontID2)
ButtonGadget(131,700,460,80,25,"Stop")
SetGadgetFont(131,FontID2)
; Boucle générale
Repeat
Event = WaitWindowEvent()
If Event = #WM_LBUTTONDOWN
SendMessage_(WindowID(100), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
EndIf
If Event = #PB_Event_Gadget
Select EventGadget()
Case 117 ;cible
pathcible2$ = GetGadgetText(117)
If pathcible2$ <> ""
SetGadgetText(105,pathcible2$)
EndIf
Case 130;bt transfert
tico$ = GetGadgetText(105)+ GetGadgetText(119) + GetGadgetText(120)
SaveIcon( GetGadgetState(27),tico$)
EnableWindow_(hWinForeGround, #True)
CloseWindow(100)
Break
Case 131;bt stop
EnableWindow_(hWinForeGround, #True)
CloseWindow(100)
Break
EndSelect
EndIf
ForEver
EndProcedure
OpenWindow(0,0,0,1600,900,"Ma Fenêtre",#PB_Window_BorderLess | #PB_Window_Invisible | #PB_Window_ScreenCentered)
SetWindowCallback(@WindowProc())
SetClassLongPtr_(WindowID(#fenpr),#GCL_STYLE,$00020000)
HideWindow(#fenpr,0)
SetWindowColor(#fenpr,$DCE4DC)
N$ = " EXTRACT | ICONES"
For x = 1 To Len(N$)
L$ = L$ + Mid(N$,x,1) + Chr(10)
Next
TextGadget(1,0,0,30,900,L$,#PB_Text_Center)
SetGadgetColor(1,#PB_Gadget_BackColor,$7FFF00)
SetGadgetFont(1,FontID1)
TextGadget(2,40,10,100,28,"Source")
TextGadget(3,40,530,100,28,"Taille")
TextGadget(4,40,610,200,28,"Sélection")
TextGadget(5,40,710,150,28,"Commandes")
TextGadget(6,380,10,150,28,"Icone(s)")
For gad = 2 To 6
couletic(gad)
Next
ExplorerTreeGadget(10,31,50,310,430, "",#PB_Explorer_NoMyDocuments|#PB_Explorer_GridLines|#PB_Explorer_AlwaysShowSelection )
SetGadgetColor(10,#PB_Gadget_BackColor,$DCE4DC)
SetGadgetColor(10,#PB_Gadget_FrontColor,$EE6E43)
SetGadgetColor(10,#PB_Gadget_LineColor,$13458B)
SetGadgetFont(10,FontID2)
FrameGadget(11,31,480,310,50,"",#PB_Frame_Flat)
FrameGadget(12,31,565,310,30,"",#PB_Frame_Flat)
FrameGadget(13,31,645,310,50,"",#PB_Frame_Flat)
FrameGadget(14,31,745,310,110,"",#PB_Frame_Flat)
TextGadget(20,32,481,308,40,"")
SetGadgetFont(20,FontID2)
SetGadgetColor(20,#PB_Gadget_BackColor,$DCE4DC)
SetGadgetColor(20,#PB_Gadget_FrontColor,$EE6E43)
OptionGadget(23,80,568,80,25,"16 X 16")
SetGadgetFont(23,FontID2)
OptionGadget(24,220,568,80,25,"32 X 32")
SetGadgetFont(24,FontID2)
SetGadgetState(24,1)
ContainerGadget(26,349,49,1231,806,#PB_Container_Double)
SetGadgetColor(26,#PB_Gadget_BackColor,$DCE4DC)
ListIconGadget(25,0,0,1230,804, "Column 1", 100)
SetGadgetColor(25,#PB_Gadget_BackColor,$DCE4DC)
SetGadgetAttribute(25, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
TextGadget(44,200,300,900,70,"Recherche et extraction d'icone(s)")
HideGadget(44,1)
SetGadgetColor(44,#PB_Gadget_BackColor,$DCE4DC)
SetGadgetFont(44,FontID5)
CloseGadgetList()
ImageGadget(27,160,655, 35, 35, 0)
ButtonGadget(30,186,755,150,45,"Tranfert")
ButtonGadget(31,35,801,150,45,"Barre de tâche")
ButtonGadget(32,35,755,150,45,"Extraction")
ButtonGadget(33,186,801,150,45,"Stop")
For x = 30 To 33
SetGadgetFont(x,FontID2)
Next
TextGadget(40,40,865,180,28,"Examine fichiers:")
SetGadgetFont(40,FontID1)
SetGadgetColor(40,#PB_Gadget_FrontColor,$FF0000)
TextGadget(41,1330,865,100,28,"Icone(s):")
SetGadgetFont(41,FontID1)
SetGadgetColor(41,#PB_Gadget_FrontColor,$FF0000)
TextGadget(42,230,872,1200,20,"")
SetGadgetFont(42,FontID4)
SetGadgetColor(42,#PB_Gadget_FrontColor,$E22B8A)
TextGadget(43,1440,865,140,28,"")
SetGadgetFont(43,FontID1)
SetGadgetColor(43,#PB_Gadget_FrontColor,$FF0000)
For zz = 40 To 43
SetGadgetColor(zz,#PB_Gadget_BackColor,$DCE4DC)
HideGadget(zz,1)
Next
; Boucle générale
Repeat
Event = WaitWindowEvent(10)
If Event = #WM_LBUTTONDOWN
SendMessage_(WindowID(#fenpr), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
EndIf
If Event = #PB_Event_Gadget
Select EventGadget()
Case 10 ;source
Select EventType()
Case #PB_EventType_LeftClick
If GetGadgetText(10) <> GetGadgetText(20) :ClearGadgetItems(25):EndIf
HideGadget(41,1):HideGadget(43,1)
pathcible$ = GetGadgetText(10)
If pathcible$ = "":pathcible$ = "Ce PC":EndIf
SetGadgetText(20,pathcible$)
EndSelect
Case 23; 16 x 16
ResizeGadget(27,168,665,#PB_Ignore,#PB_Ignore):SetGadgetState(27,0)
Dim tabicochem.s(0):nbico.q = 0
SetGadgetState(23, 1)
cdico()
Case 24; 32 x 32
ResizeGadget(27,160,655,#PB_Ignore,#PB_Ignore):SetGadgetState(27,0)
Dim tabicochem.s(0):nbico.q = 0
SetGadgetState(24, 1)
cdico()
Case 25
Select EventType()
Case #PB_EventType_LeftClick
item.q = GetGadgetState(25)
If item <> -1
selectico(Item.q)
EndIf
EndSelect
Case 30;transfer
If GetGadgetState(27) <> 0; ouvre la fenêtre transfert que si ily a eu un choix d'icone
fs()
EndIf
Case 31
ShowWindow_(WindowID(0),#SW_MINIMIZE)
Case 32
Dim tabicochem.s(0):nbico.q = 0
Dim tabicochem(0):nbico.q = 0
cdico()
Case 33 ;stop
FreeArray(tabicochem.s())
CloseWindow(0)
Break
EndSelect
EndIf
ForEver
End
.Mais sur ce coup tu as raison j'ai rectifier dans les remerciements. Car j'ai quand même un peu épuré le code de la procédure pour virer les curseurs. 
: Ce zinzin te sera certainement utile. 
