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.
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.