' ------------------------------------------------------------------------------------
'					SortOnCFDateFr.vbs
'         Tri d'un album
' Les champs personnalisés Date et Heure sont utilisés pour le tri.
' ------------------------------------------------------------------------------------

Option Explicit

app.ClearTrace

dim alb, sCF1, sCF2
set alb = app.GetCurrentAlbum
sCF1 = "Date"
sCF2 = "Heure"


dim s, k
s = "Ce script va trier l'album courant en utilisant les champs personalisés '" & sCF1 & "' et '" & sCF2 & "'." & chr(13)
s = s & "Album utilisé : " & alb.sAlbumTitle & " (" & alb.FullName & ")" & chr(13)
s = s & "Cliquer sur Oui pour continuer" & chr(13)
s = s & "Cliquer sur Non pour interrompre"
k = MsgBox( s, vbYesNo, "SortOnCFFr" )

if k = vbYes then

  Dim nbPic, i, pic, pic2, nbMoved, d1, d2
  nbPic = alb.nbPicture
  app.Trace "Images à trier :" & nbPic, -1, TRACE_INFORMATION

  ' Tri très simple avec une double boucle (très lent si beaucoup d'images...)
  do
    nbMoved = 0
    for i = 0 to nbPic-2
      Set pic = alb.GetPicture(i)
      Set pic2 = alb.GetPicture(i+1)
      d1 = pic.GetCustomFieldDate(sCF1)
      d2 = pic2.GetCustomFieldDate(sCF1)
      if d2 < d1 then
        alb.MovePicture pic2, i, False
        nbMoved = nbMoved + 1
      else
        if (d2 = d1) and (pic2.GetCustomFieldDate(sCF2) < pic.GetCustomFieldDate(sCF2)) then
          alb.MovePicture pic2, i, False
          nbMoved = nbMoved + 1
        end if
      end if
    next
    app.Trace "  Tri en cours...  " & nbMoved & " images déplacées..."
  loop until nbMoved = 0

  alb.Redraw
  app.Trace "Fini !", -1, TRACE_GREENDOT
end if