PureBasic

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)

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

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

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

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

Merci pour le code

Merci beaucoup Celtic. Jolie réalisation.

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())

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

PureBasic

convertir une image en icon

convertir une image en icon

Re: convertir une image en icon

Re: convertir une image en icon

Re: convertir une image en icon

Re: convertir une image en icon

Re: convertir une image en icon

Re: convertir une image en icon

Re: convertir une image en icon