Icône associé à un type de fichier

Le Soldat Inconnu

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

Dr. Dri · Message par **Dr. Dri** » dim. 13/juin/2004 12:08

Backup · Message par **Backup** » dim. 13/juin/2004 12:41

c'est vrai ça !!

on fait comment pour sauver une image dont on a que l'ID

et que

Code : Tout sélectionner

SaveImage(#Image

demande un numero !!

la solution serai de scanner l'image
avec la fonction Couleur = Point(x, y) ?? !!

pour se recreer un image valide (avec numero d'image)

fweil · Message par **fweil** » dim. 13/juin/2004 13:46

ben on créé une image en copiant avec l'ImageID et on sauve la copie ... ?

Backup · Message par **Backup** » dim. 13/juin/2004 14:59

oui mais "CopyImage(#Image1, #Image2) "
a besoin du numero de l'image !! quant tu n'a que l'ID ????

Le Soldat Inconnu

en parlant de ce code, y'a un bug avec la structure LV_Item qui n'est pas bonne

Denis, tu l'as trouvé ou celle là ?

ça me bouffait une variable string et j'ai mis du temps à trouvé que cette structure était à l'ouest. 2 ou 3 param de trop, ça donnant lieu à des débordement.

donc la correction :

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

Dr. Dri · Message par **Dr. Dri** » dim. 13/juin/2004 15:41

Le Soldat Inconnu

avec un BitBlt_() de l'image dont tu n'as que le handle vers une image PB ?
j'ai pas essayé mais ça doit marcher

comtois · Message par **comtois** » dim. 13/juin/2004 17:23

J'ai fait l'essai avec ça, et ensuite je fais coller depuis paint ,mais il me dit qu'il y a une erreur !
Sinon j'ai vu un code de Freak dans codeArchiv qui permet de transférer une icone sur une image pour la modifier , je n'ai pas testé .

Code : Tout sélectionner

SetClipboardData(#PB_ClipboardImage, ImageID())

Dr. Dri · Message par **Dr. Dri** » dim. 13/juin/2004 17:30

Dr. Dri · Message par **Dr. Dri** » dim. 13/juin/2004 17:41

Anonyme2 · Message par **Anonyme2** » dim. 13/juin/2004 21:04

Le Soldat Inconnu a écrit :en parlant de ce code, y'a un bug avec la structure LV_Item qui n'est pas bonne

Denis, tu l'as trouvé ou celle là ?

Dans la doc SDK de microsoft tout simplement. Beaucoup de structures ont évolué avec XP voir avec 2000 et depuis le jour ou je t'ai corrigé un code qui plantait à cause d'une structure, je vérifie systématiquement les structures avec celles déclarées en PB. Freak doit travailler sur ce problème il me semble.

http://msdn.microsoft.com/library/defau ... lvitem.asp