PureBasic

Code : Tout sélectionner

Procedure.l ExtractSmallIconFile(IconPath.s)
  ; Cette procedure permet d'extraire l'ID de l'icône 16*16 associé au type de fichier ou au dossier dont l'adresse est IconPath
  SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON)
  ProcedureReturn InfosFile\hIcon
EndProcedure

Procedure.l ExtractLargeIconFile(IconPath.s)
  ; Cette procedure permet d'extraire l'ID de l'icône 32*32 associé au type de fichier ou au dossier dont l'adresse est IconPath
  SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_LARGEICON)
  ProcedureReturn InfosFile\hIcon
EndProcedure

Procedure ListIconGadgetXP(GadgetID.l, x.l, y.l, tx.l, ty.l, colonne.s, largeur.l, options.l)
  ListIconGadget(GadgetID, x, y, tx, ty, colonne, largeur, options)
  #LVM_SETEXTENDEDLISTVIEWSTYLE = 4150 : #LVS_EX_SUBITEMIMAGES = 2
  hImageListS.l = SHGetFileInfo_("c:\", 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON)
  SendMessage_(GadgetID(GadgetID), #LVM_SETIMAGELIST, #LVSIL_SMALL, hImageListS)
  SendMessage_(GadgetID(GadgetID), #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
EndProcedure

Procedure AddGadgetItemXP(GadgetID.l, Pos.l, Texte.s, IconPath.s)
  SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON)
  If Pos = -1
    Pos = CountGadgetItems(GadgetID) + 1
  EndIf
  
  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
  
  var.LVITEM
  Var\mask = #LVIF_IMAGE | #LVIF_TEXT
  Var\iSubItem = 0
  Var\iItem = Pos
  Var\pszText = @Texte
  Var\iImage = InfosFile\iIcon
  Sendmessage_(GadgetID(GadgetID), #LVM_INSERTITEM, 0, @Var)
EndProcedure

;- -------------- Exemple de chargement d'image ----------------

#Window_0 = 0
#SizeWindowX = 300
#SizeWindowY = 200

Procedure Open_Window_0()
  
  If OpenWindow(#Window_0, 400, 400, #SizeWindowX, #SizeWindowY, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "essai icône")
    If CreateGadgetList(WindowID())
      ButtonGadget(2, 40, 5, 200, 25, "Ouvrir un fichier")
      ImageGadget(0, 0, 0, 32, 32, ExtractLargeIconFile(""))
      ListIconGadgetXP(1, 0, 40, 300, 160, "fichiers", 200, #PB_ListIcon_CheckBoxes)
      
    EndIf
  EndIf
EndProcedure

Procedure bouton()
  IconPath.s = OpenFileRequester("", "c:\", "Tous les fichiers|*.*", 0)
  If IconPath <> ""
    FreeGadget(0)
    ImageGadget(0, 0, 0, 32, 32, ExtractLargeIconFile(IconPath))
    AddGadgetItemXP(1, -1, IconPath, IconPath)
  EndIf
EndProcedure

;- debut du programme
Open_Window_0()
ClicDroit = 0

Repeat
  Event = WaitWindowEvent()
  
  If Event = #PB_EventGadget
    Select EventGadgetID() ; boutons, zone de texte, ...
      Case 2
        bouton()
    EndSelect
  EndIf
  
Until Event = #PB_EventCloseWindow

End

Code : Tout sélectionner

SaveImage(#Image

Code : Tout sélectionner

; Auteur : Denis - Le Soldat Inconnu
; Version de PB : 3.90
;
; Explication du programme :
; Permet d'avoir une ListIconGadget qui supporte les icônes au format XP.



Procedure ListIconGadgetXP(GadgetID.l, x.l, y.l, tx.l, ty.l, colonne.s, largeur.l, options.l)
  ; Même paramètres que pour une ListIconGadget, seule le paramètres options est obligatoire, mettre 0 si vous ne mettez pas d'option
  ListIconGadget(GadgetID, x, y, tx, ty, colonne, largeur, options)
  #LVM_SETEXTENDEDLISTVIEWSTYLE = 4150 : #LVS_EX_SUBITEMIMAGES = 2
  hImageListS.l = SHGetFileInfo_("c:\", 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON)
  SendMessage_(GadgetID(GadgetID), #LVM_SETIMAGELIST, #LVSIL_SMALL, hImageListS)
  SendMessage_(GadgetID(GadgetID), #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
EndProcedure

Procedure AddGadgetItemXP(GadgetID.l, Pos.l, Texte.s, IconPath.s)
  Protected var.LV_ITEM
  ; GadgetID : Numéro de la ListIconGadgetXP
  ; Pos : position à laqualle on souhaite insérer l'élément
  ; Texte : Texte de l'élément
  ; IconPath : Fichier dont on souhaite affiché l'icône
  
  SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON)
  If Pos = -1
    Pos = CountGadgetItems(GadgetID) + 1
  EndIf
  
  var\mask = #LVIF_IMAGE | #LVIF_TEXT
  var\iSubitem = 0
  var\iItem = Pos
  var\pszText = @Texte
  var\iImage = InfosFile\iIcon
  SendMessage_(GadgetID(GadgetID), #LVM_INSERTITEM, 0, @var)
EndProcedure





;- Exemple de chargement d'image

#Window_0 = 0
#SizeWindowX = 300
#SizeWindowY = 200

Procedure Open_Window_0()
  
  If OpenWindow(#Window_0, 400, 400, #SizeWindowX, #SizeWindowY, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Test - Icône")
    If CreateGadgetList(WindowID())
      ButtonGadget(2, 5, 5, 200, 25, "Ouvrir un fichier")
      
      ; Création d'une ListIconGadget qui supporte les icônes au format XP
      ListIconGadgetXP(1, 0, 40, 300, 160, "fichiers", 200, #PB_ListIcon_CheckBoxes)
      
    EndIf
  EndIf
EndProcedure


Procedure bouton() ; si on souhaite ourir un fichier
  IconPath.s = OpenFileRequester("", "c:\", "Tous les fichiers|*.*", 0)
  If IconPath <> ""
    AddGadgetItemXP(1, -1, IconPath, IconPath) ; on ajoute le fichier à la liste
  EndIf
EndProcedure

;- debut du programme
Open_Window_0()
ClicDroit = 0

Repeat
  Event = WaitWindowEvent()
  
  If Event = #PB_EventGadget
    Select EventGadgetID() ; boutons, zone de texte, ...
      Case 2
        bouton()
    EndSelect
  EndIf
  
Until Event = #PB_EventCloseWindow

End

Code : Tout sélectionner

SetClipboardData(#PB_ClipboardImage, ImageID())