[RESOLU]Afficher les icones devant nom fichier

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Avatar de l’utilisateur
omega
Messages : 633
Inscription : sam. 26/nov./2011 13:04
Localisation : Alger

[RESOLU]Afficher les icones devant nom fichier

Message par omega »

Salut à toute l'équipe

Bon, ça y est, mon programme ftp marche bien, il reste juste une petite chose:

Comment afficher l'icone devant le nom du fichier dans une listIconGadget (que j'utilise pour les fichiers distants) (je souhaite que l'affichage ressemble à celui de la listegadgetexplorer qui liste les fichiers locaux, cela afin que l'utilisateur puisse ouvrir un répertoire par exemple et donc changer de chemin)

J'espère que je suis suffisamment clair

Merci
Dernière modification par omega le dim. 17/mars/2013 12:49, modifié 1 fois.
Win7 (x64) 64 bits Pb 5.72
Azur
Messages : 40
Inscription : ven. 22/mai/2009 23:58

Re: Afficher les icones devant nom fichier

Message par Azur »

Code : Tout sélectionner

EnableExplicit

; structure fichier pour stocker le contenu d'un dossier
; nom.s du fichier
; type.b peut être dossier, fichier

Structure fichier
  nom.s
  type.b
EndStructure 

; j'utilise une liste chainée pour stocker le contenu du dossier scanné

Global NewList repertoire.fichier()

; la fenetre et les gadgets 

Define win=OpenWindow(#PB_Any,0,0,800,600,"List icon",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
Global liste=ListIconGadget(#PB_Any,10,10,780,480,"Liste",600)
Global parcourir=ButtonGadget(#PB_Any,10,500,100,20,"Parcourir un dossier")

; Création de deux images icones de 16*16

Global iconeRepertoire=CreateImage(#PB_Any,16,16)
Global iconeFichier=CreateImage(#PB_Any,16,16)

; icone pour dossier sera verte

StartDrawing(ImageOutput(iconeRepertoire))
  Box(0,0,16,16,RGB(0,255,0))
StopDrawing()
; oui je suis aussi artiste à mes heures perdues 

; icone pour fichier sera bleue

StartDrawing(ImageOutput(iconeFichier))
  Box(0,0,16,16,RGB(0,0,255))
StopDrawing()

;__________________________________ fin des inits

; procedure quitter

Procedure sortie()
  End
EndProcedure  

; parcourir un dossier 
; premiere phase je vais remplir ma liste chainée avec le contenu du dossier
Procedure parcour()
  ClearList(repertoire())
  Define chem.s=PathRequester("Un dossier","")
    Define d=ExamineDirectory(#PB_Any,chem.s,"*.*")
    If d
      While NextDirectoryEntry(d)
        AddElement(repertoire())
        repertoire()\type=2
        If DirectoryEntryType(d)=#PB_DirectoryEntry_File
          repertoire()\type=1
        EndIf
        repertoire()\nom=DirectoryEntryName(d)
      Wend
      FinishDirectory(d)
    EndIf
EndProcedure

; afficher le contenu du dossier parcouru dans listicongadget

Procedure affiche()
  FirstElement(repertoire())
  ForEach(repertoire())
    If repertoire()\type=1
      AddGadgetItem(liste,0,repertoire()\nom,ImageID(iconeRepertoire))
    EndIf
  Next
  FirstElement(repertoire())
  ForEach(repertoire())
    If repertoire()\type=2
      AddGadgetItem(liste,0,repertoire()\nom,ImageID(iconeFichier))
    EndIf
  Next
EndProcedure

;scan des évenements 

Procedure scan()
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      sortie()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case parcourir
          parcour()
          affiche()
      EndSelect
  EndSelect
EndProcedure

; boucle principale

Procedure mainLoop()
  Repeat
    scan()
  ForEver
EndProcedure

; lancer le prog

mainLoop()
Avatar de l’utilisateur
falsam
Messages : 7324
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Afficher les icones devant nom fichier

Message par falsam »

@Azur : Bien mais pas d'icone des fichiers lus.

@Omega : Un code qui te permet d'afficher l'icone d'un fichier que tu glisses (Drag and drop) dans ta listicongadget.

Code : Tout sélectionner

Enumeration
  #Mainform
  #FileExplorer
EndEnumeration

Define.l Event, GEvent, TEvent

Global WindowStyle.i=#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_SizeGadget
Global File.s

;Retrieves the icon associated to a file (By Goznal)
Procedure GetAssociatedFileIcon(IconPath.s, IconSize)
  Protected FileInfo.SHFILEINFO
  ; http://msdn.microsoft.com/en-us/library/bb762179%28VS.85%29.aspx
  ; #SHGFI_SMALLICON     -> small (usually 16x16) icon
  ; #SHGFI_LARGEICON     -> large (usually 32x32) icon
  ; #SHGFI_SHELLICONSIZE -> shell default icon size
  SHGetFileInfo_(IconPath, 0, @FileInfo, SizeOf(SHFILEINFO), #SHGFI_ICON | IconSize) 
  ProcedureReturn FileInfo\hIcon 
EndProcedure

Procedure Open_MainForm()
  OpenWindow(#Mainform, 0, 0, 500, 400, "New Form", WindowStyle)
  ListIconGadget(#FileExplorer, 10, 10, 480, 380, "Fichier", 200) 
  EnableGadgetDrop(#FileExplorer, #PB_Drop_Files, #PB_Drag_Copy)
EndProcedure

Open_MainForm()

Repeat
  Event  = WaitWindowEvent(10)
  GEvent = EventGadget()
  TEvent = EventType()
  
  Select Event
    Case #PB_Event_Gadget
      Select GEvent      
          
      EndSelect
      
    Case #PB_Event_GadgetDrop
      If GEvent = #FileExplorer  
        File = EventDropFiles()
        AddGadgetItem(#FileExplorer, GetGadgetState(#FileExplorer), File, GetAssociatedFileIcon(File, #SHGFI_SMALLICON))
      EndIf
      
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Azur
Messages : 40
Inscription : ven. 22/mai/2009 23:58

Re: Afficher les icones devant nom fichier

Message par Azur »

Visiblement monsieur falsam, nous ne mangeons pas les mêmes rillettes lol.
Je ne sais pas, moi je dirais plutôt qu'un des deux code affiche effectivement une icône dans 100% de cas...
Après prendre son GIMP pour dessiner une dizaine d'icônes et parser les extensions de nom de fichier c'est pas la mort du petit cheval pour avoir un code portable.
Ceci dit la fonction pour recup l’icône avec l'API est bien intéressante en effet.
Avatar de l’utilisateur
falsam
Messages : 7324
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Afficher les icones devant nom fichier

Message par falsam »

Azur a écrit :Visiblement monsieur falsam, nous ne mangeons pas les mêmes rillettes lol.
Azur, j'adore votre sens de l'humour :p Mea culpa, j'ai mal compris la demande d'Omega. Je viens de comprendre que la listicongadget contenait les noms des fichiers se trouvant sur l'unité ftp et qu'omega souhaitait récupérer les icones de ces fichiers. La solution d'omega passe effectivement par votre code. (j'aime ce vouvoiement que Je n'utilise pas d'habitude sur ce forum).
Azur a écrit :Ceci dit la fonction pour recup l’icône avec l'API est bien intéressante en effet.
Je posterai un code un peu plus complet dans la section trucs et astuce.

/me tend une belle tartine de rillettes accompagnée d'un verre d'un excellent vin de Bordeaux. :)
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Re: Afficher les icones devant nom fichier

Message par Anonyme2 »

Je pense que la méthode de falsam est la bonne (il y en a d'autre avec les interfaces) pour afficher l'icône (connu du shell au moment de l'affichage).

Pour l'API SHGetFileInfo , 2 choses :
1)
il faut initialiser avec CoInitializeEx_(0, #COINIT_APARTMENTTHREADED|#COINIT_SPEED_OVER_MEMORY) ou CoInitializeEx_(0, #COINIT_APARTMENTTHREADED) , éviter CoInitialize_() et il faut utiliser CoUninitialize_() à la fin du programme pour libérer tout le fourbi :mrgreen: .
J'ai posté ce que je croyais être un bug sur le forum anglais car ça plantait mon pc mais d'autres codeurs n'avaient pas le même problème, encore un mystère MS.
le post du pseudo bug sur le forum en
http://www.purebasic.fr/english/viewtop ... =4&t=53608

2) Chaque icône extraite doit être détruite avec l'API DestroyIcon_()
C'est ce MS dit ici
http://msdn.microsoft.com/en-us/library ... 85%29.aspx
If SHGetFileInfo returns an icon handle in the hIcon member of the SHFILEINFO structure pointed to by psfi, you are responsible for freeing it with DestroyIcon when you no longer need it.
et pour la remarque 1 c'est le même lien
You must initialize Component Object Model (COM) with CoInitialize or OleInitialize prior to calling SHGetFileInfo.
Et comme avec MS tout est simple, si on clique sur le lien de CoInitialize, on peut lire ce que je vous ait dit
New applications should call CoInitializeEx instead of CoInitialize.
Avatar de l’utilisateur
omega
Messages : 633
Inscription : sam. 26/nov./2011 13:04
Localisation : Alger

Re: Afficher les icones devant nom fichier

Message par omega »

Bonjour à tous

Bon, je crois qu'en testant mon code vous comprendrez mieux ce que je veux, regardez vers la liste de droite qui contient les fichiers distants (ftp), ils ne sont précédés d'icones comme c'est le cas d'une listGadgetExplorer...

Code : Tout sélectionner

  Enumeration
#Mainform
#SeparLigne1
#Source
#Destination
#Connection
#FrameFtpInfo
#AdFtpTxt
#AdFtp
#exemple1
#UserFtpTxt
#UserFtp
#exemple2
#MpFtpTxt
#MpFtp
#RepLocalFtpTxt
#RepLocalFtp
#exemple3
#RepDistantFtpTxt
#RepDistantFtp
#exemple4
#CheckMemoriser
#FrameFtpCon
#Connexion
#parcourir
#SelectLocalPath
#LocalPath
#localExplorer
#SelectFtpPath
#FtpPath
#FtpExplorer
#Transferer
#StatutList
#FrameObs
#Ftp
EndEnumeration

UseJPEGImageDecoder()
UsePNGImageDecoder()

trans=CatchImage(0, ?trans)
parcourir=CatchImage(1, ?parcourir)
connecter=CatchImage(2, ?connecter)

DataSection
trans:
IncludeBinary "images\trans.jpg"
parcourir:
IncludeBinary "images\open.jpg"
connecter:
IncludeBinary "images\connecter.jpg"
EndDataSection

Global WindowStyle.i=#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_SizeGadget
Global ErrorFound,Result,LocalPath$,FtpPath$,WChemin$,wFileSelected$
Global NbreFT,NbreEchec,Item
Global WFtp$,WuserFtp$,WMpFtp$

ExamineDesktops()
Wlargeur=DesktopWidth(0)
Whauteur=DesktopHeight(0)
If OpenWindow(#Mainform, 0,0, Wlargeur, Whauteur, "Pro_FTP", WindowStyle)
   If CreateGadgetList(WindowID(#Mainform))
      WLar=(Wlargeur-100)/2:WHaut=(Whauteur/2) : wrow=260 : wcol=70+wlar 

      Frame3DGadget(#FrameFtpInfo,10,10,460,170,"Paramètres de connexion...")
      TextGadget(#AdFtpTxt, 20, 30, 100, 20,"Serveur FTP :")
      ComboBoxGadget(#AdFtp, 120, 30, 200, 100,#PB_ComboBox_Editable)      
      TextGadget(#Exemple1, 330, 30, 110, 20,"(ex.: ftp.purebasic.com)")
      TextGadget(#UserFtpTxt, 20, 55, 100, 20,"Nom utilisateur :")
      ComboBoxGadget(#UserFtp, 120, 55, 200, 100,#PB_ComboBox_Editable)      
      TextGadget(#Exemple2, 330, 55, 110, 20,"(ex.: fred)")
      TextGadget(#MpFtpTxt, 20, 80, 100, 20,"Mot de passe :")
      StringGadget(#MpFtp, 120, 80, 200, 20,"",#PB_String_Password)      
      TextGadget(#RepLocalFtpTxt, 20, 105, 100, 20,"Répertoire local")
      ButtonImageGadget(#parcourir, 96, 102, 25, 22, ImageID(1))
      StringGadget(#RepLocalFtp, 122, 105, 198, 20,"")      
      TextGadget(#Exemple3, 330, 105, 110, 20,"(ex.: c:\mes fichiers\")
      TextGadget(#RepDistantFtpTxt, 20, 130, 100, 20,"Répertoire distant")
      StringGadget(#RepDistantFtp, 120, 130, 200, 20,"")      
      TextGadget(#Exemple4, 330, 130, 110, 20,"(ex.: \public_html\")
      CheckBoxGadget(#CheckMemoriser,120,150,250,20,"Mémoriser les paramètres de connexion")     

      ButtonImageGadget(#Connection, 9+wlar, 55, 61, 45, ImageID(2))

      Frame3DGadget(#FrameFtpCon,wcol,10,460,170,"Statut...")
      ListViewGadget(#StatutList, wcol+10, 30, 440,135)

      Frame3DGadget(#SeparLigne1,10,wrow-70,wlargeur-42,6,"",#PB_Frame3D_Single)

      ButtonImageGadget(#SelectLocalPath,10, wrow-15, 30, 20,ImageID(1))
      TextGadget(#LocalPath, 40, wrow-15, wlar-30, 20,"", #PB_Text_Border)
      ExplorerListGadget(#LocalExplorer, 10, wrow+10, Wlar, whaut, "", #PB_Explorer_MultiSelect)
      ButtonImageGadget(#Transferer, 15+wlar, wrow+90, 49, 30, ImageID(0))

      ButtonImageGadget(#SelectFtpPath, wcol, wrow-15, 30, 20,ImageID(1))
      TextGadget(#FtpPath, wcol+30, wrow-15, wlar-30, 20,"", #PB_Text_Border)
      ListIconGadget(#FtpExplorer, wcol, wrow+10, wlar, whaut,"Nom",160,#PB_ListIcon_GridLines )
      AddGadgetColumn(#FtpExplorer,1, "Taille", 80)
      AddGadgetColumn(#FtpExplorer,2, "Type", 80)
      AddGadgetColumn(#FtpExplorer,3, "Date modification", 130)

   EndIf 
EndIf

SetGadgetColor(#StatutList,#PB_Gadget_BackColor,RGB(98, 98, 98))
SetGadgetColor(#StatutList,#PB_Gadget_FrontColor,RGB(230, 230, 230))
SetGadgetColor(#exemple1,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
SetGadgetColor(#exemple2,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
SetGadgetColor(#exemple3,  #PB_Gadget_FrontColor,RGB(140, 140, 140))
SetGadgetColor(#exemple4,  #PB_Gadget_FrontColor,RGB(140, 140, 140))

GadgetToolTip(#Transferer, "Démarrer le transfert...") 
GadgetToolTip(#Parcourir, "Parcourir...") 
GadgetToolTip(#SelectFtpPath, "Parcourir...") 
GadgetToolTip(#SelectLocalPath, "Parcourir...") 
GadgetToolTip(#Connection, "Se connecter...") 

DisableGadget(#Transferer,1)

;Valeurs par défaut (pour test)

WFtp$="ftp.purebasic.com"
WuserFtp$="fred"
WMpFtp$="abcdef"
LocalPath$="D:\"
FtpPath$="/public_html"

wDate$ = FormatDate("%dd/%mm/%yyyy", Date())

SetGadgetText(#AdFtp,WFtp$)
SetGadgetText(#UserFtp,WuserFtp$)
SetGadgetText(#MpFtp,WMpFtp$)
SetGadgetText(#RepLocalFtp,LocalPath$)
SetGadgetText(#RepDistantFtp,FtpPath$)
SetGadgetText(#LocalPath,LocalPath$)
SetGadgetText(#FtpPath,FtpPath$)

InitNetwork()

Repeat 
EventID = WaitWindowEvent()

If EventID = #PB_Event_CloseWindow
   End
EndIf
             
If EventID = #PB_Event_Gadget
   Select EventGadget()

   Case #Connection
         ClearGadgetItemList(#FtpExplorer)
         WFtp$=GetGadgetText(#AdFtp)
         WuserFtp$=GetGadgetText(#UserFtp)
         WMpFtp$=GetGadgetText(#MpFtp)
         LocalPath$=GetGadgetText(#RepLocalFtp)
         FtpPath$=GetGadgetText(#RepDistantFtp)

         If wFtp$=""
            MessageRequester("Erreur","Adresse FTP incorrecte  ! ")
            Goto Fin_Connection
         EndIf
         If wUserFtp$=""
            MessageRequester("Erreur","Nom utilisateur incorrect  ! ")
            Goto Fin_Connection
         EndIf
         If wMpFtp$=""
            MessageRequester("Erreur","Mot de passe incorrect  ! ")
            Goto Fin_Connection
         EndIf
         If LocalPath$=""
            MessageRequester("Erreur","Saisissez le répertoire initial local ! ")
            Goto Fin_Connection
         EndIf
         If FtpPath$=""
            MessageRequester("Erreur","Indiquez le répertoire initial distant ! ")
            Goto Fin_Connection
         EndIf
         
         ;Tentative de connection au serveur ftp...
         ;Cette adresse ftp marche : 127.0.0.1         
          
         If OpenFTP(#ftp, wFtp$, WuserFtp$, wMpFtp$)
            MessageRequester("Etat de la connection", "Serveur ftp connecté avec succès")
         Else
            MessageRequester("Connection error", "Impossible de se connecter au serveur !")
            Goto Fin_Connection
         EndIf
         
         SetGadgetText(#FtpExplorer,FtpPath$)

         If SetFTPDirectory(#Ftp, FtpPath$)
            If ExamineFTPDirectory(#Ftp)
               While NextFTPDirectoryEntry(#Ftp)
                      Wtype=FTPDirectoryEntryType(#Ftp)
                      Wdate=FTPDirectoryEntryDate(#Ftp)
                      wDate$ = FormatDate("%dd/%mm/%yyyy", wDate)
                      If wtype =#PB_FTP_File
                         AddGadgetItem(#FtpExplorer,-1,FTPDirectoryEntryName(#Ftp)+Chr(10)+""+Chr(10)+"fichier"+Chr(10)+wdate$)

                      EndIf
                      If wtype =#PB_FTP_Directory
                         AddGadgetItem(#FtpExplorer,-1,FTPDirectoryEntryName(#Ftp)+Chr(10)+""+Chr(10)+"dossier"+Chr(10)+wdate$)
                      EndIf
               Wend
           EndIf
        EndIf
        
   Fin_Connection :
              
   Case #LocalExplorer
        If EventType()=#PB_EventType_Change
           wchemin$=GetGadgetText(#LocalExplorer)
           SetGadgetText(#LocalPath,wchemin$)
           LocalPath$=wchemin$
        EndIf
    
   Case #FtpExplorer
        If EventType()=#PB_EventType_Change
           wchemin$=GetGadgetText(#FtpExplorer)
           SetGadgetText(#FtpPath,wchemin$)
           FtpPath$=wchemin$
        EndIf

   Case #SelectFtpPath 
         WChemin$=PathRequester("Sélectionnez un dossier:", FtpPath$)
         If wchemin$
            SetGadgetText(#FtpPath,wChemin$)
            SetGadgetText(#FtpExplorer,wChemin$)
            ResizeGadget(#FtpExplorer, #PB_Ignore, #PB_Ignore,#PB_Ignore, #PB_Ignore)
            FtpPath$=wchemin$
         EndIf    
   
   Case #SelectLocalPath 
         WChemin$=PathRequester("Sélectionnez un dossier:", LocalPath$)
         If wchemin$
            SetGadgetText(#LocalPath,wChemin$)
            SetGadgetText(#LocalExplorer,wChemin$)
            ResizeGadget(#LocalExplorer, #PB_Ignore, #PB_Ignore,#PB_Ignore, #PB_Ignore)
            LocalPath$=wchemin$
         EndIf    

   Case #Parcourir
         WChemin$=PathRequester("Sélectionnez un dossier:", LocalPath$)
         If wchemin$
            SetGadgetText(#RepLocalFtp,wChemin$)
            SetGadgetText(#LocalExplorer,wChemin$)
            SetGadgetText(#LocalPath,wchemin$)
            ResizeGadget(#LocalExplorer, #PB_Ignore, #PB_Ignore,#PB_Ignore, #PB_Ignore)
            LocalPath$=wchemin$
         EndIf    

   Case #Transferer
         ErrorFound=0
         NbreFt=0
         NbreEchec=0
         ClearGadgetItemList(#StatutList)
         
         FtpPath$=GetGadgetText(#FtpPath)
         
         If ExamineDirectory(0,  FtpPath$, "*.*")  
            If NextDirectoryEntry(0) And DirectoryEntryName(0)<>"." And DirectoryEntryName(0)<>".." 
               FinishDirectory(0)
            EndIf
         Else
            Result = MessageRequester("Erreur", "Le dossier de destination n'existe pas. Voulez-vous le créer? ", #PB_MessageRequester_YesNo)
            If Result =6
               If CreateDirectory(FtpPath$) 
                  MessageRequester("Nouveau dossier","Le dossier " + FtpPath$+ " a été créé avec succès!")
               Else
                  MessageRequester("Erreur","Le dossier " + FtpPath$+ " n'a pas pu être créé!")
                  ErrorFound=1
               EndIf
            Else
               ErrorFound=1
            EndIf                          
         EndIf
                           

         If ErrorFound=1 : Goto Fin_Transfert : EndIf
         
         ;------------ Transfert de fichiers 
         For item=0 To CountGadgetItems(#LocalExplorer)
             If GetGadgetItemState(#LocalExplorer, item) & #PB_Explorer_Selected
                wFileSelected$=GetGadgetItemText(#LocalExplorer, item)   
                If GetGadgetItemState(#LocalExplorer, item) & #PB_Explorer_Directory
                   If CopyDirectory(wFileSelected$, FtpPath$ + wFileSelected$, "",#PB_FileSystem_Recursive | #PB_FileSystem_Force)
                      AddGadgetItem (#StatutList,-1,Space(10) + wFileSelected$ + " a été transféré avec succès")
                      NbreFt=NbreFt+1
                   Else
                      AddGadgetItem (#StatutList,-1,Space(10)+wFileSelected$ + " n'a pas pu être transféré")
                      NbreEchec=NbreEchec+1
                   EndIf
                EndIf    
                If GetGadgetItemState(#LocalExplorer, item) & #PB_Explorer_File
                   If CopyFile(wFileSelected$, FtpPath$ + wFileSelected$)
                      AddGadgetItem (#StatutList,-1,Space(10)+wFileSelected$ + " a été transféré avec succès")
                      NbreFt=NbreFt+1
                   Else
                      AddGadgetItem (#StatutList,-1,Space(10)+wFileSelected$ + " n'a pas pu être transféré")
                      NbreEchec=NbreEchec+1
                   EndIf
                EndIf    
             EndIf   
         Next item    
         If NbreEchec=0 And NbreFt=0
            MessageRequester("Erreur","Aucun fichier n'a été sélectionné pour le tansfert !")
         Else   
            AddGadgetItem (#StatutList,-1,"___________________________________________________________")
            AddGadgetItem (#StatutList,-1,Space(10)+" Transfert terminé !")
            AddGadgetItem (#StatutList,-1,Space(10)+" Nbre de fichiers transférés : " + Str(NbreFt))
            AddGadgetItem (#StatutList,-1,Space(10)+" Nbre de fichiers non transférés : " + Str(NbreEchec))
         EndIf
                     
   Fin_Transfert :
        
   EndSelect
EndIf    
ForEver
(Mettre une adresse ftp correcte bien entendu ..)

Merci
Win7 (x64) 64 bits Pb 5.72
Avatar de l’utilisateur
omega
Messages : 633
Inscription : sam. 26/nov./2011 13:04
Localisation : Alger

Re: Afficher les icones devant nom fichier

Message par omega »

Ah.. encore une chose:

Merci de ne pas tenir compte de ce morceau de code:

Code : Tout sélectionner

;Tentative de connection au serveur ftp...
;Cette adresse ftp marche : 127.0.0.1         

Je devais l'enlever, mais cela ne change rien au programme..
[/code]

@Azur
Je sais que tu n'aimes pas les GO TO, mais je te promets que je ferais tout
pour les éviter prochainement (ce code ftp, quand il fonctionnera parfaitement,
je les enlèverais)

c promis Azur !

Merci
Win7 (x64) 64 bits Pb 5.72
Avatar de l’utilisateur
falsam
Messages : 7324
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Afficher les icones devant nom fichier

Message par falsam »

Bonjour Omega. Je vais insister une derniére fois.
Utilise ce code pour trouver l'icone associée à ton fichier

Code : Tout sélectionner

Procedure GetAssociatedFileIcon(IconPath.s)
  Protected FileInfo.SHFILEINFO
  SHGetFileInfo_(IconPath, 0, @FileInfo, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON | #SHGFI_USEFILEATTRIBUTES) 
  ProcedureReturn FileInfo\hIcon 
EndProcedure
remplace

Code : Tout sélectionner

AddGadgetItem(#FtpExplorer,-1,FTPDirectoryEntryName(#Ftp)+Chr(10)+""+Chr(10)+"fichier"+Chr(10)+wdate$)
par

Code : Tout sélectionner

Fichier$ =  FTPDirectoryEntryName(#Ftp)
Icon = GetAssociatedFileIcon(Fichier$)
AddGadgetItem(#FtpExplorer,-1,Fichier$+Chr(10)+""+Chr(10)+"fichier"+Chr(10)+wdate$, Icon)
Par contre tu n'auras pas l'icone des dossiers. Je pense que j'ai une astuce que je posterais dans la section trucs et astuces de ce forum.

Encore une chose : La version actuel de PureBasic est la 5.10 :mrgreen:
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
omega
Messages : 633
Inscription : sam. 26/nov./2011 13:04
Localisation : Alger

Re: Afficher les icones devant nom fichier

Message par omega »

Bonjour Falsam et merci beaucoup de ton aide

Je vais tester ça tout de suite
Par contre tu n'auras pas l'icone des dossiers. Je pense que j'ai une astuce que je posterais dans la section trucs et astuces de ce forum.
Mais puisqu'on connait l'icone des dossiers (en standard) et qu'on peut savoir s'il s'agit d'un dossier ou pas, n'est il pas possible de forcer l'affichage de l'icone-dossier devant son nom?

C'est juste une suggestion...

Merci
Win7 (x64) 64 bits Pb 5.72
Avatar de l’utilisateur
falsam
Messages : 7324
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Afficher les icones devant nom fichier

Message par falsam »

omega a écrit :Mais puisqu'on connait l'icone des dossiers (en standard) et qu'on peut savoir s'il s'agit d'un dossier ou pas, n'est il pas possible de forcer l'affichage de l'icone-dossier devant son nom?
C'est juste une suggestion...
C'est une solution. :)
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
omega
Messages : 633
Inscription : sam. 26/nov./2011 13:04
Localisation : Alger

Re: Afficher les icones devant nom fichier

Message par omega »

@Falsam

J'ai testé ta solution.
Merci beaucoup ça marche !
Il ne reste plus que l'icone des dossiers..(c'est nécessaire car je dois donner le choix
aux utilisateurs pour choisir le répertoire dans lequel ils doivent télécharger les fichiers)

Merci encore
Win7 (x64) 64 bits Pb 5.72
Avatar de l’utilisateur
falsam
Messages : 7324
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Afficher les icones devant nom fichier

Message par falsam »

Tu peux résoudre le probléme de l'icone des dossiers de cette maniére.
:arrow: Modifie la procédure que je t'ai donné par celle ci :

Code : Tout sélectionner

;Récupère l'icône associée à un fichier
Procedure GetAssociatedFileIcon(IconPath.s, Value.l)
  Protected FileInfo.SHFILEINFO
  SHGetFileInfo_(IconPath, 0, @FileInfo, SizeOf(SHFILEINFO), #SHGFI_ICON | Value) 
  ProcedureReturn FileInfo\hIcon 
EndProcedure
:arrow: Remplace

Code : Tout sélectionner

Fichier$ =  FTPDirectoryEntryName(#Ftp)
Icon = GetAssociatedFileIcon(Fichier$)
AddGadgetItem(#FtpExplorer,-1,Fichier$+Chr(10)+""+Chr(10)+"fichier"+Chr(10)+wdate$, Icon)
par

Code : Tout sélectionner

Fichier$ =  FTPDirectoryEntryName(#Ftp)
Icon = GetAssociatedFileIcon(Fichier$, #SHGFI_SMALLICON | #SHGFI_USEFILEATTRIBUTES)
AddGadgetItem(#FtpExplorer,-1,Fichier$+Chr(10)+""+Chr(10)+"fichier"+Chr(10)+wdate$, Icon)
:arrow: Mémorise quelques par l'icone des dossiers par défaut
FolderIcon = GetAssociatedFileIcon(GetHomeDirectory(), #SHGFI_SMALLICON)

:arrow: Et enfin
remplace

Code : Tout sélectionner

If wtype =#PB_FTP_Directory
  AddGadgetItem(#FtpExplorer,-1,FTPDirectoryEntryName(#Ftp)+Chr(10)+""+Chr(10)+"dossier"+Chr(10)+wdate$)  
EndIf
par

Code : Tout sélectionner

If wtype =#PB_FTP_Directory
  AddGadgetItem(#FtpExplorer,-1,FTPDirectoryEntryName(#Ftp)+Chr(10)+""+Chr(10)+"dossier"+Chr(10)+wdate$, FolderIcon)  
EndIf
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
omega
Messages : 633
Inscription : sam. 26/nov./2011 13:04
Localisation : Alger

Re: Afficher les icones devant nom fichier

Message par omega »

@Falsam

Merci beaucoup, ça marche, tu es génial !
Win7 (x64) 64 bits Pb 5.72
Répondre