Visualisation et gestion de fichiers images

Télécharger le projet
Commenter

Description

Amateur de photo numerique, je voulais avoir un utilitaire simple et efficace pour visualiser, renommer, déplacer ou supprimer mes fichiers. VB6 m'a permis d'avoir une réponse à mon besoin, je vous la sousmet!
J'utilise au maximum les automatismes de VB (DriveList, DirList, FileList, ...). Le plus dur pour moi fut de "maitriser" la taille du controle image !
Tel qu'il est, ce petit applicatif ne traite que des fichiers .jpg, .gif et .bmp mais ce n'est pas une limite, il suffit d'enrichir les lignes :

' Evolution du 17/10/2003 suggérée par Renfield
Public MonExtension As String
' Evolution du 18/10/2003 suggérée par Renfield
Public fso as Object

Dans Public Sub Form_Load()

MonExtension = "UCase(Right$(FileList1.List(FileList1.ListIndex), 4))"
Set fso = CreateObject("Scripting.FileSystemObject")

Dans Public Sub FileList1_Click()

If InStr(MonExtension, ".JPG".GIF.BMP") <> -1 Then

...............

End If

Les fonctions de traitements ont été modifiées en conséquences

Source / Exemple : 


Public Chemin As String, Acces As String
Public Disque As String, Repertoire As String, Fichier As String

' Evolution du 17/10/2003 suggérée par Renfield : vrai simplification
Public MonExtension As String
' Evolution du 18/10/2003 suggérée par Renfield : là aussi , découverte pour moi !!
Public fso As Object

Public Sub Form_Load()
    
    On Error Resume Next
    
    ' Positionement de la feuille
    Form1.Left = 3180
    Form1.Top = 1530
    
    ' Initialisation des états
    
    BtnRepertoire.Visible = False
    Label2.Visible = False
    TxtRepertoireCible.Visible = False
    BtnMoveFichier.Visible = False
    
    MonExtension = "UCase(Right$(FileList1.List(FileList1.ListIndex), 4))"
    Set fso = CreateObject("Scripting.FileSystemObject")
    
End Sub

Public Sub BtnQuitter_Click()
    
    End
    
End Sub

Public Sub DriveList1_Change()
    
    DirList1.Path = DriveList1.List(DriveList1.ListIndex)
    
End Sub

Public Sub DirList1_Change()
    
    FileList1.Path = DirList1.Path
    
End Sub

Public Sub FileList1_Click()
    
    Dim TemString As String, i As Integer, k As Double
    
    MousePointer = vbHourglass
    
    Chemin = DirList1.Path
        
    Acces = Trim(DirList1.Path & "\" & FileList1.List(FileList1.ListIndex))
    
    ' Affichage apres analyse de l'extension
    
    ' If InStr(MonExtension, ".JPG.GIF.BMP") <> -1 : Evolution du 17/10/2003 suggérée
    ' par Renfield : nous discutâmes beaucoup car
    ' je ne l'avais jamais utilisé sous cette forme !!!
    ' Toutefois, sous Win9x, les extensions à 4 lettres ne sont pas comprises (sur ma machine !)
    
    If InStr(MonExtension, ".JPG.GIF.BMP") <> -1 Then
    
        On Error GoTo FinFileListClick
        
        ' Effacement du contenu du controle
        Set Apercu.Picture = LoadPicture
        
        ' Le contrôle se redimensionne en fonction de la taille de l'élément graphique
        Apercu.Stretch = False
        
        ' Chargement de l'image
        Set Apercu.Picture = LoadPicture(Acces)
        
        ' Redimensionnement du controle
        If (4935 / Apercu.Width) > (3720 / Apercu.Height) Then
            
            k = 3720 / Apercu.Height
        
        ElseIf (3720 / Apercu.Height) > (4935 / Apercu.Width) Then
            
            k = 4935 / Apercu.Width
            
        End If
        
        Apercu.Height = Apercu.Height * k
        Apercu.Width = Apercu.Width * k
        
        ' L'élément graphique se redimensionne selon la taille du contrôle
        Apercu.Stretch = True
        
        ' Affichage des informations fichier
        Call ShowAcces(Acces)
        
        ' Aremement du champ texte de "rename"
        TxtRename = FileList1.List(FileList1.ListIndex)
        
    End If
    
FinFileListClick:
    MousePointer = vbDefault
    
End Sub

Public Sub FileList1_PathChange()
    
    Chemin = DirList1.Path
        
    Acces = Trim(DirList1.Path & "\" & FileList1.List(FileList1.ListIndex))
    
    ' Affichage des dates
    Call ShowAcces(Acces)
        
End Sub

Public Sub BtnRenommer_Click()
    '
    Dim CheminDriveList As String
    Dim CheminDirList As String
    Dim CheminFileList As String
    '
    CheminDriveList = DriveList1.ListIndex
    CheminDirList = DirList1.List(DirList1.ListIndex)
    CheminFileList = Trim(DirList1.Path & "\" & Form1.TxtRename)
    '
    
    Call TraiteFichier("Rename", Trim(DirList1.Path & "\" & FileList1.List(FileList1.ListIndex)), _
                       "")
    '
    Set Apercu.Picture = LoadPicture
    '
    DriveList1.ListIndex = CheminDriveList
    Call DriveList1_Change
    '
    DirList1.Path = CheminDirList
    Call DirList1_Change
    '
    FileList1.Path = Trim(DirList1.Path & "\")
    Call FileList1_PathChange
    '
End Sub

Public Sub BtnSuppimer_Click()
    '
    Dim CheminDriveList As String
    Dim CheminDirList As String
    Dim CheminFileList As String
    '
    CheminDriveList = DriveList1.ListIndex
    CheminDirList = DirList1.List(DirList1.ListIndex)
    CheminFileList = Trim(DirList1.Path & "\" & Form1.TxtRename)
    '
    If MsgBox("Voulez vous supprimer le fichier ?", vbYesNo) = vbYes Then
        '
        
        Call TraiteFichier("Delete", Trim(DirList1.Path & "\" & FileList1.List(FileList1.ListIndex)), _
                            "")
        '
        Set Apercu.Picture = LoadPicture
        '
        DriveList1.ListIndex = CheminDriveList
        Call DriveList1_Change
        '
        DirList1.Path = CheminDirList
        Call DirList1_Change
        '
        FileList1.Path = Trim(DirList1.Path & "\")
        Call FileList1_PathChange
        '
    End If
End Sub

Public Sub BtnMoveFichier_Click()
    '
    Dim CheminDriveList As String
    Dim CheminDirList As String
    Dim CheminFileList As String
    '
    CheminDriveList = DriveList1.ListIndex
    CheminDirList = DirList1.List(DirList1.ListIndex)
    CheminFileList = Trim(DirList1.Path & "\" & Form1.TxtRename)
    '
    If MsgBox("Voulez vous déplacer le fichier ?", vbYesNo) = vbYes Then
        '
        
        Call TraiteFichier("Move", Trim(DirList1.Path & "\" & FileList1.List(FileList1.ListIndex)), _
                            Trim(DirList2.Path & "\" & FileList1.List(FileList1.ListIndex)))
        '
        Set Apercu.Picture = LoadPicture
        '
        DriveList1.ListIndex = CheminDriveList
        Call DriveList1_Change
        '
        DirList1.Path = CheminDirList
        Call DirList1_Change
        '
        FileList1.Path = Trim(DirList1.Path & "\")
        Call FileList1_PathChange
        '
    End If
    
End Sub

Public Sub DirList2_Change()
    
    BtnRepertoire.Visible = True
    Label2.Visible = True
    TxtRepertoireCible.Visible = True
    BtnMoveFichier.Visible = True
    
End Sub

Public Sub BtnRepertoire_Click()
    
    Dim Acces As String
    
    If TxtRepertoireCible.Text <> "" Then
        
        If MsgBox("Etes vous sur de vouloir créer un répertoire ?", vbYesNo) = vbYes Then
            
            MkDir Trim(DirList2.Path & "\" & Trim(TxtRepertoireCible.Text))
            
        End If
        
    End If
    
End Sub

Public Function IdentDrive()
    '
    Dim d, dc, s, n
    '
    Set dc = fso.Drives
    '
    For Each d In dc
        If AfficheTypeLecteur(d.DriveLetter) = "CD-ROM" And d.IsReady Then
           
           IdentDrive = d.DriveLetter
           Exit For
           
        End If
    Next
    '
End Function

Public Function IdentVolume()
    '
    Dim d, dc
    '
    Set dc = fso.Drives
    '
    For Each d In dc
        If AfficheTypeLecteur(d.DriveLetter) = "CD-ROM" And d.IsReady Then
           
            If d.DriveType = Remote Then
                IdentVolume = d.ShareName
            Else
                IdentVolume = d.VolumeName
            End If
            Exit For
        End If
    Next
    '
End Function

Public Function AfficheTypeLecteur(drvpath)
    
    Dim d
    
    Set d = fso.GetDrive(drvpath)
    
    Select Case d.DriveType
        Case 0: AfficheTypeLecteur = "Inconnu"
        Case 1: AfficheTypeLecteur = "Amovible"
        Case 2: AfficheTypeLecteur = "Fixe"
        Case 3: AfficheTypeLecteur = "Réseau"
        Case 4: AfficheTypeLecteur = "CD-ROM"
        Case 5: AfficheTypeLecteur = "Disque RAM"
    End Select
    
End Function

Public Function ShowAcces(filespec As String)
  
  Dim f, s
  
  On Error GoTo FinLast
  
  Set f = fso.GetFile(filespec)
  
  Form1.TxtDateCreation = f.DateCreated
  Form1.TxtDateModification = f.DateLastModified
  Form1.TxtDateDernierAcces = f.DateLastAccessed
    
FinLast:
End Function

Public Sub TraiteFichier(Traite As String, specfichier As String, SpecfichierDest As String)
    
    Dim f, s
    
    On Error GoTo FinTraiteFichier
    
    Set f = fso.GetFile(specfichier)
    
    If Traite = "Rename" Then
    
        f.Name = Form1.TxtRename
        
    ElseIf Traite = "Delete" Then
    
        f.Delete
        
    ElseIf Traite = "Move" Then
    
        f.Move SpecfichierDest
        
    End If
    

FinTraiteFichier:
End Sub

Conclusion :


Pour l'instant, je n'ai pas vu de bug. Toutefois, la liste des types de fichiers images pouvant être traités est tout à fait extensible.
L'ajout d'un ElseIf permettrait de traiter également les .mov. Mais là il faudra faire appel à quelque chose comme "Lecteur Window Media" enfin un "truc" qui lise et affiche les fichiers .mov ! Pardonnez moi de ne pas encore savoir faire ! Mais, promis, dès que je saurai faire, j'enrichirai. Mais si vous savez, donnez la solution et par avance, merci
Sur ma machine (P4 2GHz Win98 512Mo Ram Geforce ti4200 128M 8x) les extensions à 4 caractères ne sont pas comprises.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (radioham)