Ajout d'images dans une ListIconGadget()

Programmation avancée de jeux en PureBasic
Répondre
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Ajout d'images dans une ListIconGadget()

Message par comtois »

J'ai repris le code de Denis , et j'ai vainement tenté de mettre des images dans une listIconGadget(), et rien à faire.J'ai fait des essais avec des fichiers .PNG et .BMP.

Bon là je colle mon dernier essai , mais j'ai aussi fait des essais avec ces lignes en dehors de la procedure importer() et ça ne fonctionnait pas mieux . Alors qu'est-ce que je fais mal ?

Code : Tout sélectionner

        ;modif de dernière minute , avant le create image était en dehors de la procedure !
        If CountGadgetItems(#ListIconGadget1)=0
          ;create an Image List : first And second param are icon size 
          Hwnd_ListSmall = ImageList_Create_(ImageWidth(),ImageHeight(),#ILC_MASK | #ILC_COLOR32, 0, 30) 
          ;assign the image list to the ListIconGadget 
          SendMessage_(GadgetID(#ListIconGadget1), #LVM_SETIMAGELIST, #LVSIL_SMALL, Hwnd_ListSmall) 
        EndIf

Code : Tout sélectionner

UseJPEGImageDecoder()
UsePNGImageDecoder()

Structure LVITEM 
  Mask.l 
  iItem.l 
  iSubItem.l 
  State.l 
  stateMask.l 
  pszText.l 
  cchTextMax.l 
  iImage.l 
  lParam.l 
  iIndent.l 
  iGroupId.l 
  cColumns.l 
  puColumns.l 
EndStructure 

Enumeration 
  #FenetrePrincipale 
  #ListIconGadget1 
  #Image 
EndEnumeration 

;/Le menu
Enumeration
  #MenuImporterTiles
  #MenuQuitter
  #MenuAProposDe
EndEnumeration


Procedure AddItem(gadget.l, Row.l, Column.l, Text$, ImageIndex.l) 
  ; add an item with an image from the ListImage or a subitem without image 
  ; put -1 to ImageIndex to not display Image 
  ; fill up var to set subitem icon and text 
  var.LVITEM 
  
  var\Mask = #LVIF_IMAGE | #LVIF_TEXT 
  var\iItem = Row         ; row number 
  var\iSubItem = Column   ; subitem 
  var\pszText = @Text$    ; text to set 
  var\iImage = ImageIndex ; index of icon in the list 
  
  ; set text + icon in the listicongadget item/subitem 
  If Column 
    SendMessage_(GadgetID(gadget), #LVM_SETITEM, 0, @var) 
  Else 
    SendMessage_(GadgetID(gadget), #LVM_INSERTITEM, 0, @var) 
  EndIf 
EndProcedure 

Procedure Importer() 
  NomFichier$ = OpenFileRequester("Importe Tiles", "","Fichiers Images|*.BMP;*.PNG;*.JPG"  , 0,#PB_Requester_MultiSelection) 
  If NomFichier$    ; teste si la chaine existe 
    Repeat 
      Fichier$ = GetFilePart(NomFichier$) ; récupère seulement le nom de fichier 
      If LoadImage(1,NomFichier$)
        ;modif de dernière minute , avant le create image était en dehors de la procedure !
        If CountGadgetItems(#ListIconGadget1)=0
          ;create an Image List : first And second param are icon size 
          Hwnd_ListSmall = ImageList_Create_(ImageWidth(),ImageHeight(),#ILC_MASK | #ILC_COLOR32, 0, 30) 
          ;assign the image list to the ListIconGadget 
          SendMessage_(GadgetID(#ListIconGadget1), #LVM_SETIMAGELIST, #LVSIL_SMALL, Hwnd_ListSmall) 
        EndIf  
        IndexImage=ImageList_AddIcon_(Hwnd_ListSmall,ImageID()) 
        AddItem(#ListIconGadget1,CountGadgetItems(#ListIconGadget1),0,Fichier$,IndexImage) 
        FreeImage(1) 
      EndIf 
      NomFichier$ = NextSelectedFileName()   
    Until NomFichier$ = ""                         
  EndIf
EndProcedure
; *************************************************************************** 

If OpenWindow(#FenetrePrincipale, 0, 0, 420, 300, #PB_Window_ScreenCentered | #PB_Window_SystemMenu, "") 
  If CreateGadgetList(WindowID()) And ListIconGadget(#ListIconGadget1, 10, 55, 400, 236, "Tiles", 398 / 5 + 70,#PB_ListIcon_FullRowSelect ) 
    
    ;/ un petit menu
    If CreateMenu(0,WindowID(#FenetrePrincipale))
      MenuTitle("Fichier")
      MenuItem(#MenuImporterTiles,"Importer Tiles...")
      MenuItem(#MenuQuitter,"Quitter")
      MenuTitle("Aide")
      MenuItem(#MenuAProposDe,"A propos de...")
    EndIf   
    

    ;create an Image List : first And second param are icon size 
    ;Hwnd_ListSmall = ImageList_Create_(128, 128,#ILC_MASK | #ILC_COLOR32, 0, 30) 
    
    ; assign the image list to the ListIconGadget 
    ;SendMessage_(GadgetID(#ListIconGadget1), #LVM_SETIMAGELIST, #LVSIL_SMALL, Hwnd_ListSmall) 
    
    ;Récupère la taille des images
    ;ImageList_GetIconSize_(Hwnd_ListSmall,@cx,@cy)	
    ;Debug cx : Debug cy
    
   
    
    Repeat 
      Select WaitWindowEvent() 
        Case #PB_EventCloseWindow 
          Quit=1  
        Case #PB_Event_Menu 
          Select EventMenuID()
            ;/Partie
            Case #MenuQuitter : Quit=1  
            Case #MenuImporterTiles
              Importer()
          EndSelect    
      EndSelect 
    Until Quit
    
  EndIf 
EndIf 

ImageList_Destroy_(Hwnd_ListSmall) 
End
Haut
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

ImageList_AddIcon_() ajoute uniquement des icônes à la listimage et pas des bmp, jpg ou autre

Pour ajouter à la liste des bmp ou autre formats que des icônes, il faut utiliser soit

ImageList_Add() pour ajouter une image ainsi que son mask de transparence

soit

ImageList_AddMasked_() pour ajouter une image dont tu fourni la couleur qui permettra à la fonction de créer le mask de transparence

Voici une petite procédure qui te permet d'utiliser les commandes Loadimage ou Catchimage et qui te donne le format, icône ou bmp (sachant que les jpg etc s'assimilent au bmp) ce qui te permet d'utiliser l'API correspondante.

Code : Tout sélectionner

Procedure GetImageType(ImageID.l)
   ; retourne -1 si c'est ni une icône ni un Bitmap
   ; sinon retourne 0 si c'est une icône et 1 si c'est un Bitmap
   
   If ImageID
      ObjectType = GetObjectType_(ImageID)
      If ObjectType = #OBJ_BITMAP
         ProcedureReturn 1
      ElseIf ObjectType = 0 ; objectype a échoué
         ; c'est un format ico
         ObjectType = GetIconInfo_(ImageID, ico.ICONINFO)
         If ObjectType And ico\fIcon
            ; ObjectType = 0
            ProcedureReturn 0
         Else
            ProcedureReturn - 1
            ; ObjectType = -1
         EndIf
      Else
         ProcedureReturn - 1
         ; ObjectType = -1
      EndIf
   Else
      ProcedureReturn - 1
      ; ObjectType = -1
   EndIf
EndProcedure
Haut
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

Super Denis , ça marche :)

pour ImageList_AddIcon_() ,je me suis laissé abuser par ListIconGadget () , je pensais que ça allait de pair :)

Je vais regarder pour intégrer ta fonction GetImageType(ImageID.l).

Merci pour tout :)

Code : Tout sélectionner

UseJPEGImageDecoder()
UsePNGImageDecoder()

Structure LVITEM 
  Mask.l 
  iItem.l 
  iSubItem.l 
  State.l 
  stateMask.l 
  pszText.l 
  cchTextMax.l 
  iImage.l 
  lParam.l 
  iIndent.l 
  iGroupId.l 
  cColumns.l 
  puColumns.l 
EndStructure 

Enumeration 
  #FenetrePrincipale 
  #ListIconGadget1 
  #Image 
EndEnumeration 

;/Le menu
Enumeration
  #MenuImporterTiles
  #MenuQuitter
  #MenuAProposDe
EndEnumeration


Procedure AddItem(gadget.l, Row.l, Column.l, Text$, ImageIndex.l) 
  ; add an item with an image from the ListImage or a subitem without image 
  ; put -1 to ImageIndex to not display Image 
  ; fill up var to set subitem icon and text 
  var.LVITEM 
  
  var\Mask = #LVIF_IMAGE | #LVIF_TEXT 
  var\iItem = Row         ; row number 
  var\iSubItem = Column   ; subitem 
  var\pszText = @Text$    ; text to set 
  var\iImage = ImageIndex ; index of icon in the list 
  
  ; set text + icon in the listicongadget item/subitem 
  If Column 
    SendMessage_(GadgetID(gadget), #LVM_SETITEM, 0, @var) 
  Else 
    SendMessage_(GadgetID(gadget), #LVM_INSERTITEM, 0, @var) 
  EndIf 
EndProcedure 

Procedure Importer() 
  Static Hwnd_ListSmall
  NomFichier$ = OpenFileRequester("Importe Tiles", "","Fichiers Images|*.BMP;*.PNG;*.JPG"  , 0,#PB_Requester_MultiSelection) 
  If NomFichier$    ; teste si la chaine existe 
    Repeat 
      Fichier$ = GetFilePart(NomFichier$) ; récupère seulement le nom de fichier 
      If LoadImage(1,NomFichier$)
        ;modif de dernière minute , avant le create image était en dehors de la procedure !
        If CountGadgetItems(#ListIconGadget1)=0
          ;create an Image List : first And second param are icon size 
          Hwnd_ListSmall = ImageList_Create_(ImageWidth(),ImageHeight(),#ILC_MASK | #ILC_COLOR32, 0, 30) 
          ;assign the image list to the ListIconGadget 
          SendMessage_(GadgetID(#ListIconGadget1), #LVM_SETIMAGELIST, #LVSIL_SMALL, Hwnd_ListSmall) 
        EndIf  
        IndexImage=ImageList_Add_(Hwnd_ListSmall,ImageID(),0) 
        Debug CountGadgetItems(#ListIconGadget1)
        Debug IndexImage
        AddItem(#ListIconGadget1,CountGadgetItems(#ListIconGadget1),0,Fichier$,IndexImage) 
        FreeImage(1) 
      EndIf 
      NomFichier$ = NextSelectedFileName()   
    Until NomFichier$ = ""                         
  EndIf
EndProcedure
; *************************************************************************** 

If OpenWindow(#FenetrePrincipale, 0, 0, 420, 300, #PB_Window_ScreenCentered | #PB_Window_SystemMenu, "") 
  If CreateGadgetList(WindowID()) And ListIconGadget(#ListIconGadget1, 10, 55, 400, 236, "Tiles", 398 / 5 + 70,#PB_ListIcon_FullRowSelect ) 
    
    ;/ un petit menu
    If CreateMenu(0,WindowID(#FenetrePrincipale))
      MenuTitle("Fichier")
      MenuItem(#MenuImporterTiles,"Importer Tiles...")
      MenuItem(#MenuQuitter,"Quitter")
      MenuTitle("Aide")
      MenuItem(#MenuAProposDe,"A propos de...")
    EndIf   
    
    Repeat 
      Select WaitWindowEvent() 
        Case #PB_EventCloseWindow 
          Quit=1  
        Case #PB_Event_Menu 
          Select EventMenuID()
            ;/Partie
            Case #MenuQuitter : Quit=1  
            Case #MenuImporterTiles
              Importer()
          EndSelect    
      EndSelect 
    Until Quit
    
  EndIf 
EndIf 

ImageList_Destroy_(Hwnd_ListSmall) 
End
Haut
Avatar de l’utilisateur
Progi1984
Messages : 2659
Inscription : mar. 14/déc./2004 13:56
Localisation : France > Rennes
Contact :
Contacter Progi1984

Message par Progi1984 »

Passage en V4 et amélioration parceque j'en avais besoin

Code : Tout sélectionner

 UseJPEGImageDecoder()
UsePNGImageDecoder()

Enumeration
  #FenetrePrincipale
  #ListIconGadget1
  #Image
EndEnumeration

Enumeration
  #MenuImporterTiles
  #MenuQuitter
  #MenuAProposDe
EndEnumeration


Procedure AddItem(gadget.l, Row.l, Column.l, Text$, ImageIndex.l)
  ; add an item with an image from the ListImage or a subitem without image
  ; put -1 to ImageIndex to not display Image
  ; fill up var to set subitem icon and text
  var.LVITEM
 
  var\Mask = #LVIF_IMAGE | #LVIF_TEXT
  var\iItem = Row         ; row number
  var\iSubItem = Column   ; subitem
  var\pszText = @Text$    ; text to set
  var\iImage = ImageIndex ; index of icon in the list
 
  ; set text + icon in the listicongadget item/subitem
  If Column
    SendMessage_(GadgetID(gadget), #LVM_SETITEM, 0, @var)
  Else
    SendMessage_(GadgetID(gadget), #LVM_INSERTITEM, 0, @var)
  EndIf
  SetGadgetItemText(#ListIconGadget1,row,text$,1)
EndProcedure

Procedure Importer()
  Static Hwnd_ListSmall
  NomFichier$ = OpenFileRequester("Importe Tiles", "","Fichiers Images|*.BMP;*.PNG;*.JPG"  , 0,#PB_Requester_MultiSelection)
  If NomFichier$    ; teste si la chaine existe
    Repeat
      Fichier$ = GetFilePart(NomFichier$) ; récupère seulement le nom de fichier
      If LoadImage(1,NomFichier$)
        ;modif de dernière minute , avant le create image était en dehors de la procedure !
        If CountGadgetItems(#ListIconGadget1)=0
          ;create an Image List : first And second param are icon size
          Hwnd_ListSmall = ImageList_Create_(ImageWidth(1),ImageHeight(1),#ILC_MASK | #ILC_COLOR32, 0, 30)
          ;assign the image list to the ListIconGadget
          SendMessage_(GadgetID(#ListIconGadget1), #LVM_SETIMAGELIST, #LVSIL_SMALL, Hwnd_ListSmall)
        EndIf 
        IndexImage=ImageList_Add_(Hwnd_ListSmall,ImageID(1),0)
        Debug CountGadgetItems(#ListIconGadget1)
        Debug IndexImage
        AddItem(#ListIconGadget1,CountGadgetItems(#ListIconGadget1),0,Fichier$,IndexImage)
        FreeImage(1)
      EndIf
      NomFichier$ = NextSelectedFileName()   
    Until NomFichier$ = ""                         
  EndIf
EndProcedure
; ***************************************************************************

If OpenWindow(#FenetrePrincipale, 0, 0, 420, 300, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
  If CreateGadgetList(WindowID(#FenetrePrincipale))
    ListIconGadget(#ListIconGadget1, 10, 55, 400, 236, "Tiles", 398 / 5 + 70,#PB_ListIcon_FullRowSelect )
    AddGadgetColumn(#ListIconGadget1, 1, "Column", 65)

    ;/ un petit menu
    If CreateMenu(0,WindowID(#FenetrePrincipale))
      MenuTitle("Fichier")
      MenuItem(#MenuImporterTiles,"Importer Tiles...")
      MenuItem(#MenuQuitter,"Quitter")
      MenuTitle("Aide")
      MenuItem(#MenuAProposDe,"A propos de...")
    EndIf   
   
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Quit=1 
        Case #PB_Event_Menu
          Select EventMenu()
            ;/Partie
            Case #MenuQuitter : Quit=1 
            Case #MenuImporterTiles
              Importer()
          EndSelect   
      EndSelect
    Until Quit
   
  EndIf
EndIf

ImageList_Destroy_(Hwnd_ListSmall)
End
Haut
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Denis a écrit : Voici une petite procédure qui te permet d'utiliser les commandes Loadimage ou Catchimage et qui te donne le format, icône ou bmp (sachant que les jpg etc s'assimilent au bmp) ce qui te permet d'utiliser l'API correspondante.

Code : Tout sélectionner

Procedure GetImageType(ImageID.l)
   ; retourne -1 si c'est ni une icône ni un Bitmap
   ; sinon retourne 0 si c'est une icône et 1 si c'est un Bitmap
   
   If ImageID
      ObjectType = GetObjectType_(ImageID)
      If ObjectType = #OBJ_BITMAP
         ProcedureReturn 1
      ElseIf ObjectType = 0 ; objectype a échoué
         ; c'est un format ico
         ObjectType = GetIconInfo_(ImageID, ico.ICONINFO)
         If ObjectType And ico\fIcon
            ; ObjectType = 0
            ProcedureReturn 0
         Else
            ProcedureReturn - 1
            ; ObjectType = -1
         EndIf
      Else
         ProcedureReturn - 1
         ; ObjectType = -1
      EndIf
   Else
      ProcedureReturn - 1
      ; ObjectType = -1
   EndIf
EndProcedure

Il y a une erreur dans le code ci-dessus, GetIconInfo_() cré 2 handle qu'il faut détruire

Code : Tout sélectionner

Procedure.l GetImageType(ImageID.l)

   ; retourne -1 si c'est ni une icône ni un Bitmap
   ; sinon retourne 0 si c'est une icône et 1 si c'est un Bitmap
     Protected ObjectType.l, ico.ICONINFO
     
     If ImageID
          ObjectType = GetObjectType_(ImageID)
          If ObjectType = 1
               ProcedureReturn 1
          ElseIf ObjectType = 0 ; GetObjectType_() a échoué
               ; c'est un format ico ?
               ObjectType = GetIconInfo_(ImageID, ico.ICONINFO)
               If ObjectType
                    DeleteObject_(ico\hbmMask)
                    DeleteObject_(ico\hbmColor)
                    If ico\fIcon
                         ProcedureReturn 0
                    EndIf
               EndIf
          EndIf
     EndIf
     ProcedureReturn -1
EndProcedure
Haut
Répondre

Revenir à « Jeux »