convertir une image en icon

[celtic88]

Salut Tout Le monde ,

j'essaie de traduire un code vers #PB,le code il sert à convertir n'importe type d'image en icon mais sans succès et je ne sais pas ce qui cloche
merci de m'aider

original code
https://www.codeproject.com/Questions/1 ... -the-color

mon code

Code : Tout sélectionner

EnableExplicit

Structure ICONDIRENTRY
  bWidth.b;          // Width, in pixels, of the image
  bHeight.b;         // Height, in pixels, of the image
  bColorCount.b;     // Number of colors in image (0 if >=8bpp)
  bReserved.b  ;       // Reserved ( must be 0)
  wPlanes.w    ;         // Color Planes
  wBitCount.w  ;       // Bits per pixel
  dwBytesInRes.l;    // How many bytes in this resource?
  dwImageOffset.l;   // Where in the file is this image?
EndStructure

Structure ICONDIR 
  idReserved.w;   // Reserved (must be 0)
  idType.w    ;       // Resource Type (1 for icons)
  idCount.w   ;      // How many images?
EndStructure

Structure GdiplusStartupInput 
  GdiplusVersion.l
  DebugEventCallback.i
  SuppressBackgroundThread.l
  SuppressExternalCodecs.l
EndStructure

Import "gdiplus.lib"
  EncoderQuality.GUID
  GdiplusStartup.l(*token, *input.GdiplusStartupInput,*output)
  GdipDisposeImage.l(GpImage)
  GdipCreateBitmapFromScan0.l(iWidth.l ,iHeight.l ,iStride.l ,iPixelFormat.l ,*pScan0 ,*iHbitmp)
  GdipDeleteGraphics.l(hGraphics.i)
  GdipCreateBitmapFromFile.l(Imagepath.s, *GpBitmap)
  GdipGetImageWidth.l(GpImage, *width)
  GdipGetImageHeight.l(GpImage, *height)
  GdipCreateHICONFromBitmap.l(GpImage, *Hicon)
  GdipGetImageThumbnail.l(GpImage,iWidth.l, iHeight.l,*GpBitmap,*hCallback,*hCallbackData)
EndImport

Procedure Gdiplus_Startup()
  Protected iToken.l=0,input.GdiplusStartupInput\GdiplusVersion = 1:GdiplusStartup(@iToken, @input, 0):ProcedureReturn iToken
EndProcedure

Procedure Gdiplus_CreateImageFromFile(sFile.s)
  Protected Gdimg:GdipCreateBitmapFromFile(sFile,@Gdimg):ProcedureReturn Gdimg
EndProcedure

Procedure Gdiplus_CreateHiconFromImage(Gdimg)
  Protected Hicon:GdipCreateHICONFromBitmap(Gdimg,@Hicon):ProcedureReturn Hicon
EndProcedure

Procedure Gdiplus_DisposeImage(Gdimg)
  ProcedureReturn GdipDisposeImage(Gdimg)
EndProcedure

Procedure Gdiplus_GetImageThumbnail(GpImage,iWidth.l, iHeight.l)
  Protected Gdimg:GdipGetImageThumbnail(GpImage,iWidth,iHeight,@Gdimg,0,0):ProcedureReturn Gdimg
EndProcedure

DisableExplicit

Gds= Gdiplus_Startup()
img=Gdiplus_CreateImageFromFile("Test.bmp")
imgt=Gdiplus_GetImageThumbnail(img,32, 32)
hicon=Gdiplus_CreateHiconFromImage(img)

ici.ICONINFO
GetIconInfo_(hicon,@ici)
ibmt.DIBSECTION:ibct.DIBSECTION
ibm=CopyImage_(ici\hbmMask,#IMAGE_BITMAP,0,0,#LR_COPYDELETEORG|#LR_CREATEDIBSECTION)
ibc=CopyImage_(ici\hbmColor,#IMAGE_BITMAP,0,0,#LR_COPYDELETEORG|#LR_CREATEDIBSECTION)
GetObject_(ibm,SizeOf(DIBSECTION),@ibmt)
GetObject_(ibc,SizeOf(DIBSECTION),@ibct)

icd.ICONDIR
icd\idType=1
icd\idCount=1

icde.ICONDIRENTRY
icde\wPlanes=ibct\dsBm\bmPlanes
icde\wBitCount=ibct\dsBm\bmBitsPixel
icde\dwBytesInRes=SizeOf(BITMAPINFOHEADER)+ibct\dsBmih\biSizeImage
icde\dwImageOffset=SizeOf(ICONINFO)+SizeOf(ICONDIRENTRY)
icde\bWidth=ibct\dsBm\bmWidth
icde\bHeight=ibct\dsBm\bmHeight

tb.BITMAPINFOHEADER
tb\biSize=SizeOf(BITMAPINFOHEADER)
tb\biPlanes=1
tb\biWidth=ibct\dsBm\bmWidth
tb\biHeight=ibct\dsBm\bmHeight+ibmt\dsBm\bmHeight
tb\biBitCount=ibct\dsBm\bmBitsPixel
tb\biSizeImage=ibct\dsBmih\biSizeImage

CreateFile(0,"Test.ico")
WriteData(0,icd,SizeOf(ICONDIR))
WriteData(0,icde,SizeOf(ICONDIRENTRY))
WriteData(0,tb,SizeOf(BITMAPINFOHEADER))
WriteData(0, ibct\dsBm\bmBits,ibct\dsBmih\biSizeImage)
WriteData(0, ibmt\dsBm\bmBits,ibmt\dsBmih\biSizeImage)
CloseFile(0)

DeleteObject_(ibm)
DeleteObject_(ibc)
DestroyIcon_(hicon)
Gdiplus_DisposeImage(img)
Gdiplus_DisposeImage(imgt)

[Zorro]

pour info , j'avais fais ça a partir de bout de codes PB

http://www.purebasic.fr/french/viewtopi ... ilit=icone

[celtic88]

loool
merci zoro , je vais étudier ton code

en ce qui concerne mon code
j'ai trouvé l'erreur, dans cette ligne

Code : Tout sélectionner

icde\dwImageOffset=SizeOf(ICONINFO)+SizeOf(ICONDIRENTRY)

remplacer par

Code : Tout sélectionner

icde\dwImageOffset=SizeOf(ICONDIR)+SizeOf(ICONDIRENTRY)

une erreur de frappe

[celtic88]

le code complète

Code : Tout sélectionner

;Coded by celtic88 (c) 06/05/2017
;Original "SaveListIconToFile" method here:https://www.codeproject.com/Questions/160699/saving-icon-files-preserving-the-color
;More info about icon here:https://msdn.microsoft.com/en-us/library/ms997538.aspx

EnableExplicit

Structure ICONDIRENTRY   
  bWidth.a;          // Width, in pixels, of the image
  bHeight.a;         // Height, in pixels, of the image
  bColorCount.a;     // Number of colors in image (0 if >=8bpp)
  bReserved.a  ;       // Reserved ( must be 0)
  wPlanes.u    ;         // Color Planes
  wBitCount.u  ;       // Bits per pixel
  dwBytesInRes.l;    // How many bytes in this resource?
  dwImageOffset.l;   // Where in the file is this image?
EndStructure

Structure ICONDIR 
  idReserved.u;   // Reserved (must be 0)
  idType.u    ;       // Resource Type (1 for icons)
  idCount.u   ;      // How many images?
EndStructure

Structure GdiplusStartupInput 
  GdiplusVersion.l
  DebugEventCallback.i
  SuppressBackgroundThread.l
  SuppressExternalCodecs.l
EndStructure

Import "gdiplus.lib"
  EncoderQuality.GUID
  GdiplusStartup.l(*token, *input.GdiplusStartupInput,*output)
  GdipDisposeImage.l(GpImage)
  GdipCreateBitmapFromScan0.l(iWidth.l ,iHeight.l ,iStride.l ,iPixelFormat.l ,*pScan0 ,*iHbitmp)
  GdipDeleteGraphics.l(hGraphics.i)
  GdipCreateBitmapFromFile.l(Imagepath.s, *GpBitmap)
  GdipGetImageWidth.l(GpImage, *width)
  GdipGetImageHeight.l(GpImage, *height)
  GdipCreateHICONFromBitmap.l(GpImage, *Hicon)
  GdipGetImageThumbnail.l(GpImage,iWidth.l, iHeight.l,*GpBitmap,*hCallback,*hCallbackData)
EndImport

Procedure Gdiplus_Startup()
  Protected iToken.l=0,input.GdiplusStartupInput\GdiplusVersion = 1:GdiplusStartup(@iToken, @input, 0):ProcedureReturn iToken
EndProcedure

Procedure Gdiplus_CreateImageFromFile(sFile.s)
  Protected Gdimg:GdipCreateBitmapFromFile(sFile,@Gdimg):ProcedureReturn Gdimg
EndProcedure

Procedure Gdiplus_CreateHiconFromImage(Gdimg)
  Protected Hicon:GdipCreateHICONFromBitmap(Gdimg,@Hicon):ProcedureReturn Hicon
EndProcedure

Procedure Gdiplus_DisposeImage(Gdimg)
  ProcedureReturn GdipDisposeImage(Gdimg)
EndProcedure

Procedure Gdiplus_GetImageThumbnail(GpImage,iWidth.l, iHeight.l)
  Protected Gdimg:GdipGetImageThumbnail(GpImage,iWidth,iHeight,@Gdimg,0,0):ProcedureReturn Gdimg
EndProcedure

Procedure SaveListIconToFile(sFile.s,List IconeList())
  Protected Error.b=1,ici.ICONINFO,ibmt.DIBSECTION,ibct.DIBSECTION,icd.ICONDIR,iFile,*a,*icde.ICONDIRENTRY,iOffset.l,index.l,ibm,ibc,tb.BITMAPINFOHEADER
  NewList listTempImage()
  
  icd\idType=1 ; Resource Type (1 for icons)
  icd\idCount=ListSize(IconeList()) ; Number of pictures
  *a=AllocateMemory(SizeOf(ICONDIRENTRY)*icd\idCount)
  If *a=0:ProcedureReturn -1:EndIf
  
  iFile=CreateFile(#PB_Any,sFile)
  If iFile=0:FreeMemory(*a):ProcedureReturn -2:EndIf
  WriteData(iFile,icd,SizeOf(ICONDIR)) ;Write Icon header
  WriteData(iFile,*a,(SizeOf(ICONDIRENTRY)*icd\idCount))
  
  iOffset=SizeOf(ICONDIR)+(SizeOf(ICONDIRENTRY)*icd\idCount);First offset of image 
  
  ForEach IconeList()
    If GetIconInfo_(IconeList(),@ici)=0:Error=-3:Break:EndIf; Get icon info
    
    ibm=CopyImage_(ici\hbmMask,#IMAGE_BITMAP,0,0,#LR_COPYDELETEORG|#LR_CREATEDIBSECTION);Copy bitmap mask
    If ibm=0:Error=-4:Break:EndIf
    AddElement(listTempImage()):listTempImage()=ibm
    
    ibc=CopyImage_(ici\hbmColor,#IMAGE_BITMAP,0,0,#LR_COPYDELETEORG|#LR_CREATEDIBSECTION);Copy bitmap Color
    If ibc=0:Error=-5:Break:EndIf
    AddElement(listTempImage()):listTempImage()=ibc
    
    If GetObject_(ibm,SizeOf(DIBSECTION),@ibmt) =0 Or GetObject_(ibc,SizeOf(DIBSECTION),@ibct)=0:Error=-6:Break:EndIf;Get bitmap info
    
    *icde=*a+(SizeOf(ICONDIRENTRY)*index)
    *icde\wPlanes=ibct\dsBm\bmPlanes; 
    *icde\wBitCount=ibct\dsBm\bmBitsPixel
    *icde\dwBytesInRes=SizeOf(BITMAPINFOHEADER)+ibct\dsBmih\biSizeImage+ibmt\dsBmih\biSizeImage;Size of  image
    *icde\dwImageOffset=iOffset                                                                ;offset of image 
    *icde\bWidth=ibct\dsBm\bmWidth
    *icde\bHeight=ibct\dsBm\bmHeight
    
    tb\biSize=SizeOf(BITMAPINFOHEADER); Create new bitmap
    tb\biPlanes=1
    tb\biWidth=ibct\dsBm\bmWidth
    tb\biHeight=ibct\dsBm\bmHeight*2
    tb\biBitCount=ibct\dsBm\bmBitsPixel
    tb\biSizeImage=ibct\dsBmih\biSizeImage+ibmt\dsBmih\biSizeImage;Size of  bitmap
    
    WriteData(iFile,tb,SizeOf(BITMAPINFOHEADER));Write new bitmap header
    WriteData(iFile, ibct\dsBm\bmBits,ibct\dsBmih\biSizeImage);Write icon image data
    WriteData(iFile, ibmt\dsBm\bmBits,ibmt\dsBmih\biSizeImage);Write icon image data
    
    iOffset+ SizeOf(BITMAPINFOHEADER)+ibct\dsBmih\biSizeImage+ibmt\dsBmih\biSizeImage; next offset of image 
    index +1
    
  Next
  FileSeek(iFile,SizeOf(ICONDIR))
  WriteData(iFile,*a,(SizeOf(ICONDIRENTRY)*icd\idCount)); rewrite header icon
  
  ;Clean
  ForEach listTempImage():DeleteObject_(listTempImage()):Next
  FreeMemory(*a)
  CloseFile(iFile)
  If Error <> 1 And FileSize(sFile)>0:DeleteFile(sFile):EndIf
  ProcedureReturn Error
EndProcedure

Procedure AddListIconIcon(himage,iWidth.l, iHeight.l,List IconeList())
  himage=Gdiplus_GetImageThumbnail(himage,iWidth, iHeight)
  If Not himage:ProcedureReturn 0:EndIf
  AddElement(IconeList()):IconeList()=Gdiplus_CreateHiconFromImage(himage)
  Gdiplus_DisposeImage(himage)
  If Not IconeList()
    DeleteElement(IconeList()):ProcedureReturn 0
  EndIf
  ProcedureReturn 1
EndProcedure

DisableExplicit

Gds= Gdiplus_Startup()

NewList IconList()
Error=0

NomFichier$=OpenFileRequester("Select a image file", "", "image|*.BMP;*.DIB;*.RLE;*.JPG;*.JPEG;*.JPE;*.JFIF;*.GIF;*.EMF;*.WMF;*.TIF;*.TIFF;*.PNG", 0, #PB_Requester_MultiSelection )
While NomFichier$
  
  img=Gdiplus_CreateImageFromFile(NomFichier$)
  If Not img:Error=1:Break:EndIf
  
  ClearList(IconList())
  
  AddListIconIcon(img,500, 400,IconList())
  AddListIconIcon(img,256, 256,IconList())
  AddListIconIcon(img,128, 128,IconList())
  AddListIconIcon(img,96, 96,IconList())
  AddListIconIcon(img,64, 64,IconList())
  AddListIconIcon(img,48, 48,IconList())
  AddListIconIcon(img,32, 32,IconList())
  AddListIconIcon(img,24, 24,IconList())
  AddListIconIcon(img,16, 16,IconList())
  
  Gdiplus_DisposeImage(img)
  
  If SaveListIconToFile(GetFilePart(NomFichier$,#PB_FileSystem_NoExtension)+".ico",IconList()) <> 1
    MessageRequester("","Error :/")
  EndIf
  
  ForEach IconList()
    DestroyIcon_(IconList())
  Next
  
  NomFichier$ = NextSelectedFileName()
Wend

[Zorro]

Merci pour le code

[falsam]

Merci beaucoup Celtic. Jolie réalisation.

[ChrisR]

Super, merci pour le code
J'ai juste noté, une éventuelle amélioration pour les images rectangulaires sans déformation
Pour pouvoir s'ouvrir avec IcoFx que j'utilise, j'ai commenté
;AddListIconIcon(img,500, 400,IconList())

[celtic88]

merci pour vos commentaires , je suis entrain d'apprendre avec vous .

Si vous aimez le sujet, voila un code pour visionner et extraire des icônes: Sans API

Code : Tout sélectionner

;Coded by celtic88 (c) 06/05/2017

Structure ICONDIRENTRY   
  bWidth.a;          // Width, in pixels, of the image
  bHeight.a;         // Height, in pixels, of the image
  bColorCount.a;     // Number of colors in image (0 if >=8bpp)
  bReserved.a  ;       // Reserved ( must be 0)
  wPlanes.u    ;         // Color Planes
  wBitCount.u  ;       // Bits per pixel
  dwBytesInRes.l;    // How many bytes in this resource?
  dwImageOffset.l;   // Where in the file is this image?
EndStructure

Structure ICONDIR 
  idReserved.u;   // Reserved (must be 0)
  idType.u    ;       // Resource Type (1 for icons)
  idCount.u   ;      // How many images?
EndStructure

Structure IconeInfo
  Width.l
  Height.l
  *Mem
  Bytesize.l
  BitsPixel.u
EndStructure

Procedure Icons_GetListIcons(icfile.s, List IconeInfolist.IconeInfo())
  Protected iConInfo.ICONDIR,*iConIEntrySt.ICONDIRENTRY,*iconEntry,pic,u.l,error.b,ci.l,ImageOffset.l
  pic=OpenFile(#PB_Any,icfile)
  If Not pic:ProcedureReturn 0:EndIf
  ReadData(pic,@iConInfo,SizeOf(ICONDIR))
  If iConInfo\idType <> 1:ProcedureReturn 0:EndIf
  *iconEntry=AllocateMemory(SizeOf(ICONDIRENTRY)*iConInfo\idCount)
  If Not *iconEntry:CloseFile(pic):ProcedureReturn 0:EndIf
  ReadData(pic,*iconEntry,SizeOf(ICONDIRENTRY)*iConInfo\idCount)
  ci= iConInfo\idCount-1
  iConInfo\idCount=1    
  ImageOffset=SizeOf(ICONDIR)+SizeOf(ICONDIRENTRY)
  For u=0 To ci
    *iConIEntrySt=*iconEntry+(SizeOf(ICONDIRENTRY)*u)
    
    AddElement(IconeInfolist())
    IconeInfolist()\Width=*iConIEntrySt\bWidth
    IconeInfolist()\Height=*iConIEntrySt\bHeight
    IconeInfolist()\Bytesize=*iConIEntrySt\dwBytesInRes+ImageOffset
    IconeInfolist()\BitsPixel=*iConIEntrySt\wBitCount
    IconeInfolist()\Mem=AllocateMemory(*iConIEntrySt\dwBytesInRes+ImageOffset)
    If Not IconeInfolist()\Mem:error=1:Break:EndIf
    CopyMemory(@iConInfo,IconeInfolist()\Mem,SizeOf(ICONDIR))
    
    FileSeek(pic,*iConIEntrySt\dwImageOffset)
    ReadData(pic,IconeInfolist()\Mem+ImageOffset,*iConIEntrySt\dwBytesInRes)
    
    *iConIEntrySt\dwImageOffset=ImageOffset
    CopyMemory(*iConIEntrySt,IconeInfolist()\Mem+SizeOf(ICONDIR),SizeOf(ICONDIRENTRY))
    
  Next
  CloseFile(pic)
  If error
    ForEach  IconeInfolist()
      If IconeInfolist()\Mem:FreeMemory(IconeInfolist()\Mem):EndIf
    Next
    ClearList(IconeInfolist())
    ProcedureReturn 0
  EndIf
  ProcedureReturn 1
EndProcedure

Global Window_Icon, Text_icon, ScrollArea_icon
Global NewList Buttonlist()

Procedure SaveIcon()
  Protected *miData=GetGadgetData(EventGadget())
  CreateFile(0,Str(GadgetWidth(EventGadget()))+"X"+Str(GadgetHeight(EventGadget()))+"  " + GetGadgetText(Text_icon))
  WriteData(0,*miData,MemorySize(*miData))
  CloseFile(0)
  MessageRequester("","Icon is saved successfully...")
EndProcedure

Procedure addButtongadgetlist(img,y,*miData,Width.l,Height.l)
  AddElement(Buttonlist())
  Buttonlist()=ButtonImageGadget(#PB_Any, 10, 10+y, Width, Height, ImageID(img))
  SetGadgetData(Buttonlist(),*miData)
  BindGadgetEvent(Buttonlist(),@SaveIcon(), #PB_EventType_LeftClick)
  GadgetToolTip( Buttonlist(),Str(Width)+"x"+Str(Height))
EndProcedure

Procedure RemoveButtongadgetlistAll()
  ForEach Buttonlist()
    FreeMemory(GetGadgetData(Buttonlist()))
    FreeGadget(Buttonlist())
  Next
  ClearList(Buttonlist())
EndProcedure

Procedure Window_IconOpen()
  Protected NomFichier$=OpenFileRequester("Select a icon file", "", "icon|*.ico", 0 )
  If NomFichier$
    SetGadgetText(Text_icon,GetFilePart(NomFichier$))
    NewList IconeInfolist.IconeInfo()
    Icons_GetListIcons(NomFichier$,  IconeInfolist())
    Protected maxHeight.l,maxWidth.l,img
    RemoveButtongadgetlistAll()
    OpenGadgetList(ScrollArea_icon)
    ForEach  IconeInfolist()
      With IconeInfolist()
        img=CatchImage(#PB_Any, \Mem)
        If img
          addButtongadgetlist(img,maxHeight,\Mem,\Width,\Height)
        EndIf
        maxHeight+\Height
        If \Width > maxWidth
          maxWidth= \Width
        EndIf
      EndWith
    Next
    CloseGadgetList()
    SetGadgetAttribute(ScrollArea_icon, #PB_ScrollArea_InnerHeight , maxHeight)
    SetGadgetAttribute(ScrollArea_icon, #PB_ScrollArea_InnerWidth , maxWidth)
  EndIf
EndProcedure

Procedure Window_Icon()
  Window_Icon = OpenWindow(#PB_Any, 0, 0, 320, 300, "Icons Extractor", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  BindGadgetEvent(ButtonGadget(#PB_Any,  230, 10, 80, 20, "Select .ico"),@Window_IconOpen(), #PB_EventType_LeftClick)
  Text_icon = TextGadget(#PB_Any, 10, 10, 220, 20, "...")
  ScrollArea_icon = ScrollAreaGadget(#PB_Any, 10, 40, 300, 250, 320, 225, 1)
EndProcedure

Window_Icon()

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow