Discussion :

[cincap]

Bonjour à toutes et à tous,

@ Charly910, merci pour ta fonction et tes suggestions :

function TailleImgJpg(Image : String) : TPoint ;

Je n'arrive pas à l'utiliser dans mon projet de test.

Ma question je l'utilise quand je fais le 1er traitement de copier le dossier original mais après avoir mis aux fichiers copiés l'extension .jpg
ou alors une fois les fichiers copiés dans le dossier final ?

Cordialement,

@+,

cincap

[Charly910]

Bonjour,

comment fais tu ? montre moi ton code.

Pour l'utiliser il faut faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  Largeur := TailleImgJpg('D:\Toto.jpg').X ;
  Hauteur := TailleImgJpg('D:\Toto.jpg').Y ;

A+
Charly

[cincap]

@ Charly910, j'ai testé en mettant les "intege"r dans le code du "copydossier" après avoir mis l'extension .jpg, cheminbis est une variable de type string qui correspond au chemin ou les fichiers ont été copiés avec l'extension.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
         //Copy du fichier et modification de l'extension
         FicRes := ToFld+sr.Name ;
         FicRes := ChangeFileExt(FicRes, '.jpg') ;
 
          Largeur := TailleImgJpg(cheminbis + ficres).X ;  //1920
          Hauteur := TailleImgJpg(cheminbis + ficres).Y ;  //1080
 
          if largeur < hauteur then Windows.CopyFile(PChar(FromFld+sr.Name), PChar(FicRes), False);
 
          //If not Windows.CopyFile(PChar(FromFld+sr.Name), PChar(FicRes), False) Then
            Begin
              Result := False ;
              FindClose(sr) ;
              Exit ;
            End

Merci,

@+,

cincap

[Charly910]

Bonjour,

je trouve que la FAQ contient peu d'items concernant les dernières versions de Delphi.

Est ce qu'il ne serait pas opportun d'y ajouter la super fonction d'Andnotor pour copier les fichiers d'un répertoire ?

Partant de cette idée j'ai légèrement modifié son code pour étendre la portée de la fonction (récursivité, overwrite ou non, et enlèvement des déclarations Var "In line" que je n'aime pas - cela me fait penser à des langages de bas de gamme ). Voici le résultat à contrôler, améliorer et valider par le grand maître, auteur de la version originale :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
{ =================================================================== }
Function CopyFolderD10(Const aSource, aDest :string ;
                          Recurs : Boolean = False ;
                          OverWrite : Boolean = True): Integer ;
//   Copie les fichiers du répertoire aSource dans le répertoire aDest
//   Version pour Delphi 10
//   si Recurs est vrai, les sous répertoires sont copiés
//   si Overwrite est vrai les fichiers exitants sont écrasés
//           Uses : System.IOUtils, System.Types, ...
Const
  TailleMin = 0 ;    // pour ne copier que les fichiers de taille >= TailleMin ko
var
  Files  : TStringDynArray;
  F, F2  : String ;
  Search : TSearchOption ;
  aSource1, aDest1 : String ;
begin
  If not DirectoryExists(aSource) or
     aDest.IsEmpty                or
     not ForceDirectories(aDest)  or
     (aSource = aDest)                then Exit(-1);
 
  aSource1 := IncludeTrailingPathDelimiter(aSource) ;    // si jamais l'un des 2 n'a pas de \ terminal
  aDest1   := IncludeTrailingPathDelimiter(aDest) ;      // utile pour la copie
 
  If Recurs Then Search := TSearchOption.soAllDirectories
            Else Search := TSearchOption.soTopDirectoryOnly ;
 
  Files := TDirectory.GetFiles(aSource, '*.*', Search, function(const Path: string; const SearchRec: TSearchRec): Boolean
                                                         Begin
                                                           Result := SearchRec.Size >= TailleMin *1024;
                                                         End) ;
  Result := 0 ;
  For F in Files do
    Begin
      F2  := StringReplace(F, aSource1, aDest1, [rfIgnoreCase]) ;
      TDirectory.CreateDirectory(TPath.GetDirectoryName(F2)) ;
      If Winapi.Windows.CopyFile(PChar(F), PChar(F2), not OverWrite) Then Inc(Result) ;
//      TFile.Copy(F, F2, Overwrite) ;    // Variante mais qui ne renvoie pas de résultat ...
    End;
end;
{ =================================================================== }

Voici un exemple d'utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
{ =================================================================== }
procedure TForm1.Button1Click(Sender: TObject);
Var
  N : Integer ;
begin
  N := CopyFolderD10('D:\Dessin1','D:\Dessin2\', True, True) ;
 
  Case N of
    -1 : ShowMessage('Erreur dans les répertoires');
     0 : ShowMessage('Aucun fichier copié');
  Else
     ShowMessage(IntToStr(N) + ' fichier(s) copiés') ;
  End;
end;
{ =================================================================== }

et si on veut compléter la FAQ, voici la version DElphi 7 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
{ =================================================================== }
Function CopyFolderD7(Const aSource, aDest :string ;
                          Recurs : Boolean = False ;
                          OverWrite : Boolean = True): Integer ;
//   Copie les fichiers du répertoire aSource dans le répertoire aDest
//   Version pour Delphi 7
//   si Recurs est vrai, les sous répertoires sont copiés
//   si Overwrite est vrai les fichiers exitants sont écrasés
//           Uses : ExtCtrls, ...
Const
  TailleMin = 0 ;    // pour ne copier que les fichiers de taille >= TailleMin ko
Var
  S       : TSearchRec ;
  FileAttrs: Integer ;
  aSource1, aDest1 : String ;
Begin
  Result := -1 ;
  If not DirectoryExists(aSource) or
     (aDest = EmptyStr)           or
     not ForceDirectories(aDest)  or
     (aSource = aDest)                then Exit;
  aSource1 := IncludeTrailingPathDelimiter(Trim(aSource)) ;
  aDest1 := IncludeTrailingPathDelimiter(Trim(aDest)) ;
  Result:=0;
  If FindFirst(aSource1+'*.*',faAnyFile,S)=0
  Then Begin
    Repeat
      If (S.Name<>'.')And(s.Name<>'..') Then
        Begin
          // cas d'un sous-repertoire on appelle la même procédure
          If ((S.Attr And faDirectory)<>0) Then
            Begin
              If Recurs Then Result := Result + CopyFolderD7(aSource1+S.FindData.cFileName,
                                                     aDest1+S.FindData.cFileName, Recurs, OverWrite)
            End
          Else
           // cas d'un fichier
            Begin
              If Winapi.Windows.CopyFile(PChar(aSource1+S.FindData.cFileName),
                                         PChar(aDest1+S.FindData.cFileName), not OverWrite) Then Inc(Result) ;
            End;
        End;
    // Recherche du suivant
    Until FindNext(S)<>0;
    FindClose(S);
  End;
End;
 
{ =================================================================== }

Que pensez vous de tout cela ?

A+
Charly

[SergioMaster]

Bonjour,

Je trouve que la FAQ contient peu d'items concernant les dernières versions de Delphi.
Est-ce qu'il ne serait pas opportun d'y ajouter la super fonction d'Andnotor pour copier les fichiers d'un répertoire ?

C'est vrai qu'en y regardant de plus près ces FAQs commencent à dater au vu des nouvelles fonctions proposées dans les nouvelles versions

La FAQ est collaborative depuis quelques années (2014) déjà donc, en gros, il suffit à l'auteur de la proposer en passant par le processus idoine, le bouton [Ajouter une question]



Voilà comment je procède lorsque je propose des FAQs : j'écris le texte (uniquement le texte) dans un bloc notes tout bête, je le passe aux outils correcteurs orthographiques que je peux avoir (bon il peut encore en rester ) ce n'est qu'ensuite que j'utilise le portail et procède aux mises en forme et ajout de code.
Je procède de cette manière car il m'est arrivé par deux fois d'avoir un problème au moment de la validation

Je ne sais plus si ensuite il faille attendre qu'un bénévole responsable de rubrique (le point d'achoppement actuel) valide à son tour la soumission.

Dans le cas de cette discussion je ne sais pas ce qu'il serait le plus judicieux : une modification des FAQs déjà présente (le petit bouton édition en bas à gauche de la réponse) ou une sorte de doublon avec dans le titre la version minima

[Charly910]

Bonjour Serge,

oui, je sais comment alimenter la FAQ, mais comme la fonction d'origine était de Andnotor, je voulais recueillir son avis, ses corrections éventuelles et surtout son aval pour publier cette FAQ.

je vais commencer à rédiger quelque chose.

Est ce qu'il ne faudrait pas aussi ouvrir une nouvelle branche de la FAQ pour D10 ?

A+
Charly

[ALWEBER]

Bonjour, il est possible de passer en revue la FAQ, de revalider l'existant en fonction de la version de Delphi et de l'enrichir en fonction des évolutions du produit (comme celle signalée par Thierry la semaine dernière sur findfirst...)
Peut être serait'il judicieux de créer un nouveau post à ce sujet.
Je suis disponible pour réaliser avec vous ce travail.

[SergioMaster]

Bonjour,

oui, je sais comment alimenter la FAQ

Je sais que tu sais c'est plus un rappel pour les lecteurs

mais comme la fonction d'origine était de Andnotor, je voulais recueillir son avis, ses corrections éventuelles et surtout son aval pour publier cette FAQ.

AMHA Ce serait plutôt par MP qu'il faudrait voir ça

Est-ce qu'il ne faudrait pas aussi ouvrir une nouvelle branche de la FAQ pour D10 ?

Ce serait sujet à débat, chaque version apportant son lot de nouveautés il faudrait presque une branche à chaque fois je pense que cela deviendrait inclassable.
La proposition de Selzig/Gilles/invité de mettre des tags (tant qu'à faire en couleur ) serait certainement plus adéquate

[Lung]

La proposition de Selzig/Gilles/invité de mettre des tags (tant qu'à faire en couleur ) serait certainement plus adéquate

+1
Ça serait plus simple et plus lisible.

[Andnotor]

comme la fonction d'origine était de Andnotor, je voulais recueillir son avis

Et bien le voici

Il y a des choses inutiles et d'autres perfectibles.

aSource1, aDest1 sont deux variables inutiles. Supprime simplement const sur aSource, aDest pour permettre leur modification (et perso, je réserve le prefix "a" pour les arguments).

aSource = aDest implique une chaîne parfaitement similaire. c:\ <> C:\, c:\folder <> c:\folder\, etc.
Ce test devrait plutôt ressembler à SameFileName(ExcludeTrailingPathDelimiter(aSource), ExcludeTrailingPathDelimiter(aDest)).

StringReplace(F, aSource1, aDest1, [rfIgnoreCase]) ne va pas. Si la source est c:\folder1\subfolder1 et la destination c:\folder1 (je veux remonter les fichiers à un répertoire racine), il n'y aura pas de copie !

TDirectory.CreateDirectory rend ForceDirectories inutile.


Après, cette fonction telle-quelle n'est pas vraiment réutilisable. Si on veut modifier les critères, c'est du copier/coller obligatoire.
Pour une réutilisabilité maximale, je conserverait peu ou prou le prototype de GetFiles :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
function CopyFolder(aSource :string; const aDest, aSearchPattern: string;
         const aSearchOption: TSearchOption;
         const aPredicate: TDirectory.TFilterPredicate): integer;
begin
  If not DirectoryExists(aSource) or aDest.IsEmpty then Exit(0);
 
  var Files := TDirectory.GetFiles(aSource, aSearchPattern, aSearchOption, aPredicate);
 
  Result := Length(Files);
 
  if Result > 0 then
  begin
    //Pour retrouver facilement le chemin relatif que aSource contienne un \ terminal ou non (Substring ci-dessous)
    //Note : cette ligne ne serait pas nécessaire si TPath.Combine contrôlait le premier cara. du 2ème paramètre
    //et le cas échéant traitait correctement un \ en début de texte. Ce n'est malheureusement pas le cas !
    aSource := IncludeTrailingPathDelimiter(aSource);
 
    for var F in Files do
    try
      var DestFilename := TPath.Combine(aDest, F.Substring(Length(aSource)));
      TDirectory.CreateDirectory(TPath.GetDirectoryName(DestFilename));
      TFile.Copy(F, DestFilename);
 
    except
      dec(Result);
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyFolder('d:\source', 'd:\dest', '*.*', TSearchOption.soTopDirectoryOnly, function(const Path: string; const SearchRec: TSearchRec): Boolean
                                                                               begin
                                                                                 Result := SearchRec.Size >= 250 *1024;
                                                                               end);
end;

Est-ce que cette fonction de copie serait utile dans la FAQ ? Je ne pense pas (mais pourquoi pas) !
Une explication sur TDirectory.GetFiles le serait beaucoup plus (cette notion de filtre est très intéressante) mais comme complément à Comment lister les fichiers d'un répertoire ?, pas forcément comme nouvelle entrée.


@cincap : désolé de polluer ce fil...

[Charly910]

Merci Andnotor,

je vais modifier mes fonctions en conséquence.

Je m'en remet à ton avis et je vais les garder pour moi.

A+
Charly

PS : je trouve le passage de aSearchOption, aPredicate en argument un peu compliqué à l'utilisation, je préfère mon Recurs, mon OverWrite et mon Taillemin !

[cincap]

Bonsoir à toutes et à tous,

@ Andnotor,

@cincap : désolé de polluer ce fil...

Aucun problème, j'en apprend aussi même si avec d6 je suis limité et dans l'impossibilité de tester.

Le remaniement du code relaté dans mon topic par Charly910 me donne déjà une solution seul hic j'aurai aimé ne copier que les fichiers de 1920 x 1080 et pas les fichiers de 1080 x 1920 qui sont dans le même dossier.

Mais je me contente de l'excellent résultat.

Encore bravo à tous les cracks de ce site qui utilisent leur temps libre pour apporter des solutions.

@+,

cincap

[tourlourou]

Ne suffit-il pas de tester la taille selon le code suggéré par Charly910 ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
function ConvientEnTaille(aFileName: String; aWidth, aHeight: integer): Boolean;
//     Uses Jpeg ...
Var
  Jpeg1: TJpegImage;
Begin
  // Test du fichier
  Result := false;
  If not FileExists(aFileName) Then Exit;
  // Chargement 
  Jpeg1 := TJpegImage.Create;
  try
    Jpeg1.LoadFromFile(aFileName);
    Result := ( Jpeg1.Width = aWidth );
    Result := Result and ( Jpeg1.Height = aHeight );
  finally
    Jpeg1.Free;
  end;
End ;

[cincap]

Bonjour à toutes et à tous,

@ tourlourou, merci de ta suggestion, j'avais bien compris le principe mais je dois l'appliquer avant de copier les fichiers et après avoir mis l'extension.

C'est la que je butte.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
FicRes := ChangeFileExt(FicRes, '.jpg') ;
if ConvientEnTaille(ficres, 1920, 1080) then Windows.CopyFile(PChar(FromFld+sr.Name), PChar(FicRes), False);

J'avais testé en .vbs et c'est ok mais comme c'est une ancienne application D6 que je modifie pour un autre usage.

@+,

cincap

[tourlourou]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if ConvientEnTaille(FromFld+sr.Name, 1920, 1080) then Windows.CopyFile(PChar(FromFld+sr.Name), PChar(ChangeFileExt(FicRes, '.jpg')), False);

[cincap]

@ tourlourou,

Merci pour la modification et l'orientation vers une solution.

J'ai testé et cela fonctionne mais comme dans le dossier il n'existe pas beaucoup de fichiers de 1920 x 1080 je ne sais pas si avec plusieurs fichiers cela fonctionnera.

Mon test :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
repeat
        If ((Sr.Name<>'.') And (sr.size>=250*1024) And ((Sr.Attr And faDirectory)=0)) Then
        begin 
 
        // Copy du fichier et modification de l'extension
         FicRes := ToFld+sr.Name ;        
 
        if ConvientEnTaille(FromFld+sr.Name, 1920, 1080) then
 
       if not Windows.CopyFile(PChar(FromFld+sr.Name), PChar(ChangeFileExt(FicRes, '.jpg')), False) 
 
            then Begin
 
              Result := False ;
              FindClose(sr) ;
              Exit ;
            End
        end;
      until FindNext(sr) <> 0 ;
      FindClose(sr) ;
    end;
  Result := True ;

En attendant que Windows remplisse ce dossier, je suis content du résultat.

@+,

cincap

[ALWEBER]

Je crois que l'information de taille est déjà contenue dans le fichier mais je n'ai plus le souvenir de la manière d'y accéder. Je cherche...

[cincap]

@ ALWEBER, merci de ton message et je te rassure la fonction remaniée me satisfait.

Sinon, un code tout simple pour voir la résolution du fichier .jpg :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
 
procedure TForm1.Button3Click(Sender: TObject);
var
  Maphoto: TPicture;
begin
  with TOpenDialog.Create(nil) do
    try
      if Execute then
      begin
        Maphoto := TPicture.Create;
        try
          Maphoto.LoadFromFile(FileName);
          Caption := Format('%d×%d', [Maphoto.Width, Maphoto.Height]) //Caption de TForm
        finally
          Maphoto.Free;
        end;
      end;
    finally
      Free;
    end;
 
end;

@+,

cincap

[Charly910]

Oui, la taille des images est dans le Jpeg, mais seulement s'il contient des données Exif et ce n'est pas si facile à extraire (si besoin j'ai un petit programme qui le fait)

A+
Charly

[Jipété]

Bonsoir,

Oui, la taille des images est dans le Jpeg, mais seulement s'il contient des données Exif et ce n'est pas si facile à extraire (si besoin j'ai un petit programme qui le fait)

Non : il suffit de le charger, la preuve avec le bout de code de cincap, que je viens de tester à l'instant avec des fichiers sans données Exif, et qui me retournent les bonnes valeurs.

Sinon, un code tout simple pour voir la résolution du fichier .jpg :

la définition ! lecture1 (le paragraphe au-dessus du sommaire), lecture2.