' ------------------------------------------------------------------------------------
'				MergeAlbums.vbs
' Merges two albums
' All the selected pictures from one album are copied to the second.
' Picture comment, keywords and custom fields are preserved.
' PMe-020105 : Update for copying of the 2.0 fields
' ------------------------------------------------------------------------------------

Option Explicit

'const CF_STRING=0
'const CF_DATE=1
'const CF_TIME=2

Function DoMerge
dim albSrc, albDst
set albSrc = app.GetAlbum(1)
set albDst = app.GetAlbum(0)

dim s, k
s = "This script will append the selected pictures from one album to another." & chr(13) & chr(13)
s = s & "First album: " & albSrc.sAlbumTitle & " (" & albSrc.FullName & ")" & chr(13)
s = s & "Second album:" & albDst.sAlbumTitle &  " (" & albDst.FullName & ")" & chr(13) & chr(13)
s = s & "Click Yes to copy 1 --> 2" & chr(13)
s = s & "Click No  to copy 2 --> 1" & chr(13) & chr(13)
s = s & "Click Cancel to abort"
k = MsgBox( s, vbYesNoCancel, "MyAlbum Merger" )

if k = vbYes or k = vbNo  then

  if k = vbNo then
    dim a
    set a = albSrc
    set albSrc = albDst
    set albDst = a
  end if

  dim i, j, kw, kw2

  ' Merge the keywords
  dim nbKW, tabKW()
  nbKW = albSrc.nbKeyword
  redim tabKW(nbKW)
  app.Trace "Source album has " & nbKW & " keywords"
  for i = 0 to nbKW-1
    set kw = albSrc.getKeyword(i)
    tabKW(i) = kw.sName
    set kw2 = albDst.addKeyword( tabKW(i) )
    app.Trace chr(9) & tabKW(i)
    if kw.bIsTab then kw2.bIsTab = True
  next

  ' Merge the custom fields
  dim nbCF, tabCF(), tabCFType()
  nbCF = albSrc.nbCustomField
  redim tabCF(nbCF), tabCFType(nbCF)
  app.Trace "Source album has " & nbCF & " custom fields"
  for i = 0 to nbCF-1
    set kw = albSrc.getCustomField(i)
    tabCF(i) = kw.sName
    tabCFType(i) = kw.nType
    s = chr(9) & tabCF(i) & " is "
    select case tabCFType(i)
      case CF_STRING
        s = s & "String"
      case CF_DATE
        s = s & "Date"
      case CF_TIME
        s = s & "Time"
    end select
    app.Trace s
    set kw2 = albDst.addCustomField( tabCF(i), tabCFType(i) )
  next

  ' Process each picture
  Dim nbPic
  nbPic = albSrc.nbPicture
  app.Trace "Pictures to copy to second album: " & nbPic

  dim pic, pic2, filename
  for i = 0 to nbPic-1
    Set pic = albSrc.GetPicture(i)
    if pic.bSelected then	' Process only the selected pictures

      ' Get the relative path of the picture
      filename = albSrc.ExpandMacro( pic, "%RP" )
      app.Trace "Processing picture #" & i+1 & " " & filename

      Set pic2 = albDst.AddPicture( filename )
      ' Copy picture information
      pic2.sComment = pic.sComment
      pic2.sURL = pic.sURL
      pic2.sPlayCmd = pic.sPlayCmd

      ' Copy the new fields of the 2.0 version
      pic2.lDisplayMode = pic.lDisplayMode
      pic2.lTransition = pic.lTransition
      pic2.rcCrop = pic.rcCrop
      pic2.nRotation = pic.nRotation

      ' Copy the keyword info
      for j = 0 to nbKW-1
        set kw = albSrc.getKeyword(j)
        if pic.HasKeyword( kw.sName ) then pic2.SetKeyword kw.sName, True
      next

      ' Copy the custom field info
      for j = 0 to nbCF-1
        set kw = albSrc.getCustomField(j)
        if kw.nType <> CF_STRING then
          k = pic.GetCustomFieldDate( kw.sName )
          if k <> 0 then pic2.SetCustomFieldDate kw.sName, k
        else
          s = pic.GetCustomField( kw.sName )
          if len(s) > 0 then pic2.SetCustomField kw.sName, s
        end if
      next
    end if
  next

  albDst.Redraw
  app.Trace "Done !"

end if
End Function


' Main program
app.ClearTrace

dim nb
nb = app.nbAlbum
if nb < 2 then
  MsgBox "Two albums should be open for the merge operation", 0, "MyAlbum Merger"
else
  DoMerge
end if