' ------------------------------------------------------------------------------------
'         			JoinPicturesFrSBee.vbs
' Ce script permet de joindre deux images en une seule en les plaçant côte-à-côte
' (soit horizontalement soit verticalement). Les vues sont supposées être rangées dans
' l'album dans l'ordre : image gauche puis image droite.
' Il est possible de générer des couples pour vision parallèle, vision croisée, haut-
' bas (ViewMagic par exemple) ou appliquer un effet mirroir sur les images (si un
' mirroir est utilisé pour la visualisation par exemple).
' Une image jointe sera créée pour chaque couple d'images sélectionnées dans l'album
' courant.
' Il est possible de spécifier un décallage pour l'image droit, indiquer ce décallage
' dans une Champ Personnalisé appelé 'Offset' :
'	Exemple: Offset: 10,-15
' (ce qui veut dire que l'image droite doit être décallée vers la droite de 10 pixels
' et vers le haut de 15 pixels).
' Version pour StereoBee (visualisateur java de AnaBuilder http://anabuilder.free.fr)
' ------------------------------------------------------------------------------------

Option Explicit

' Paramètres généraux
const sNewPicFileType = ".jpg"			' Type de fichier pour les nouvelles images
const bHorizontalJoin = True			' Joindre horizontalement (True) ou verticalement (False)
const bCrossedView = True			' Vue parallèle (False) ou croisée (True)
const sJPicTabName = "JPS"			' Nom du mot clé/onglet qui va recevoir les images jointes
const bMirrorLeftPic = False			' Effet mirroir sur l'image gauche (si True)
const bMirrorRightPic = False			' Effet mirroir sur l'image droite (si True)
const bUsePictureOffset = False			' Utiliser le Champ personnalisé 'Offset' (à positionner sur l'image droite)

' Redimensionnement des images
const bResizePictures = False			' Redimensionner les images si elles sont plus grandes que maxW et/ou maxH
const maxW = 800				' Largeur maximale d'une image
const maxH =  600				' Hauteur maximale d'une image
const bExactSize = False			' Les images seront centrées sur le rectangle maxW x maxH
const backColor = &h00				' Couleur de remplissage quand la taille des images ne correspond pas

'const sStampInfo = "%C1 %C2"			' Information to print on the picture (set to "" to print no text)
'const textColor = &hff00ff			' Text color of the comment
'const textBkColor = -1				' Transparent background
'const font ="Arial,120,0,400,0,0,0"

' Windows API constants
Const DT_CENTER = &H1		' Centers text horizontally.
Const DT_BOTTOM = &H8		' Specifies bottom-justified text.
Const DT_SINGLELINE = &H20	' Specifies single line only.
Const DT_NOPREFIX = &H800	' Turns off processing of prefix characters.

Dim alb, pic, nbPic, i, iP, pic1, pic2, newPic, picTMP, sNewFileName, x, k, kwTab, picOffset
Dim w, h, sOutputPath, dx, dy, x0, y0, x2, y2, w1, h1, w2, h2

app.ClearTrace
set alb = app.GetCurrentAlbum
if not alb is Nothing then
  if alb.nbSelectedPicture >= 2 then
    ' Using the album folder as the default output folder
    sOutputPath = alb.ExpandMacro( Nothing, "%Af" )
    sOutputPath = app.GetFilename( "Sélectionnez le dossier où ranger les images jointes (par défaut, le dossier de l'album)", 2, sOutputPath, "", 0 )

    if sOutputPath <> "" then ProcessPictures
    alb.redraw
  else
    app.Trace "Au moins 2 images doivent être sélectionnées !", -1, TRACE_WARNING
  end if
else
  app.Trace "Pas d'album disponible !", -1, TRACE_WARNING
end if
app.StatusBarText = "Fini !!!"
app.Trace "Fini !!!", -1, TRACE_OK


' ------------------------------------------------------------------------------------
function ProcessPictures
  Dim bError

  ' Create the keyword / tab that will receive the joint pictures
  if sJPicTabName <> "" then
    set kwTab = alb.AddKeyword( sJPicTabName )
    kwTab.bIsTab = True
  else
    set kwTab = Nothing
  end if

  nbPic = alb.nbPicture

  k = 0
  iP = 0
  i = 0
  while i < nbPic+k
    bError = False
    Set pic = alb.GetPicture(i)
    if pic.bSelected then
      if iP = 0 then
        ' Wait to have a pair of pictures
        set pic1 = pic
        iP = 1
      else
        if bCrossedView then
          set pic2 = pic1
          set pic1 = pic
        else
          set pic2 = pic
        end if
        set picOffset = pic
        app.Trace "Traitement de la première image :"  & vbTab & vbTab & pic1.sShortFileName & "...", -1, TRACE_INFORMATION
        app.Trace "Traitement de la seconde image :" & vbTab & vbTab & pic2.sShortFileName & "..."
        iP = 0

        ' Compute the size of the new picture using the picture size, if applicable, the offset        
        if bUsePictureOffset then
          GetPictureOffset picOffset, dx, dy
          if bCrossedView then
            dx = -dx
            dy = -dy
          end if
        else
          dx = 0
          dy = 0
        end if
        ' Compute the intersection of the left picture and offset right picture
	x0 = max( 0, dx )
	y0 = max( 0, dy )
	x2 = min( pic1.w, dx + pic2.w )-1
	y2 = min( pic1.h, dy + pic2.h )-1
	w1 = x2 - x0 + 1
	h1 = y2 - y0 + 1
        
        ' Process left picture
        Dim bOK
        bOK = True
        'PrintInfo pic1, pic1
        if not pic1.CopyRect( x0, y0, x0+w1, y0+h1, 0 ) then
          app.Trace "Erreur à la copie de la première image", 255, TRACE_ERROR
          bError = True
        end if
'app.trace "Left pic (" & x0 & ", " & y0 & ") - (" & x0+w1 & ", " & y0+h1 & ")"
        ResizePic bMirrorLeftPic
        app.StatusBarText = "Patientez..."

        ' Create a new empty picture
        if bHorizontalJoin then
          w = 2*w2
          h = h2
        else
          h = 2*h2
          w = w2
        end if
	app.trace " Taille de l'image jointe : " & w & " x " & h
        set newPic = alb.NewPicture( w, h, 24, backColor )
        CopyInfo pic1, newPic
        app.StatusBarText = "Patientez..."
        if not kwTab is Nothing then
          newPic.SetKeyword kwTab, True
        end if

        if not newpic.Paste( 0, 0 ) then
          app.Trace "Erreur au collage de la première image", 255, TRACE_ERROR
          bError = True
	end if

        ' Process right picture
        'PrintInfo pic1, pic2
        if not pic2.CopyRect( x0-dx, y0-dy, x0+w1-dx, y0+h1-dy, 0 ) then app.Trace "Erreur à la copie de la seconde image", 255, TRACE_ERROR
'app.trace "Right pic (" & x0-dx & ", " & y0-dy & ") - (" & x0+w1-dx & ", " & y0+h1-dy & ")"
        ResizePic bMirrorRightPic
        
        if bHorizontalJoin then
      	  if not newpic.Paste( w2, 0 ) then bError = True
        else
	  if not newpic.Paste( 0, h2 ) then bError = True
        end if

        if bError then
          app.Trace "Erreur au collage de la seconde image", 255, TRACE_ERROR
	else
          ' Now save the new picture using the name of the left picture and appending _Z
          sNewFileName = sOutputPath & "\" & alb.ExpandMacro( pic1, "%BF" ) & "_z" & sNewPicFileType
          app.Trace " Enregistrement de l'images jointe comme '" & sNewFileName & "'...", -1, TRACE_ARROW

          if newPic.Save( sNewFileName, True ) then
            newPic.UpdateThumbnail True
            app.StatusBarText = "Patientez..."
            ' Move the new picture just after the second picture
            if bCrossedView then
              alb.MovePicture newPic, pic1.num, True
            else
              alb.MovePicture newPic, pic2.num, True
	    end if          
            alb.nCurrentPicture = alb.CvtNumPic( newPic.num, False )
            'alb.DisplayPicture -1
            set newPic = Nothing
          else
	    app.trace "Erreur: impossible d'enregistrer l'image jointe '" & sNewFileName & "'", -1, TRACE_ERROR
          end if
        end if
        set pic1 = Nothing
        set pic2 = Nothing

        k = k + 1
        alb.Redraw
      end if
    end if
    i = i + 1
  wend
end function

' ------------------------------------------------------------------------------------
sub ResizePic( bMirrorPic )
  w2 = w1
  h2 = h1

  ' Apply mirror if needed (picture is on the Windows clipboard)
  if bMirrorPic then
    set picTmp = alb.NewPicture( w1, h1, 24, backColor )
    if not picTmp.Paste( 0, 0 ) then app.Trace "Erreur au collage de l'image miroir", 255, TRACE_ERROR
    picTmp.Mirror
    picTmp.Copy 0
    alb.DeletePicture picTmp
    set picTmp = Nothing
  end if

'app.trace " Should resize ?  w1=" & w1 & "   h1=" & h1
  if bResizePictures then 
    'if w1 >= maxW or h1 >= maxH then
      set picTmp = alb.NewPicture( w1, h1, 24, backColor )
      if not picTmp.Paste( 0, 0 ) then app.Trace "Erreur au collage de l'image redimensionnée", 255, TRACE_ERROR
    
      w2 = maxW
      h2 = maxH
      Dim nResizeMode
      if bExactSize then
        nResizeMode = RM_EXACTSIZE
      else
        nResizeMode = RM_BOUNDINGRECT
      end if
      
      'if w1 > maxW then
	'w2 = maxW	
	'h2 = round( h1 * maxW / w1 )
      'else
	'w2 = round( w1 * maxH / h1 )
	'h2 = maxH
      'end if  
      picTmp.Resize w2, h2, nResizeMode, backColor, 0
      w2 = picTmp.w
      h2 = picTmp.h
      app.trace " Redimensionnement de l'image : " & w1 & "x" & h1 & " ---> " & w2 & "x" & h2
      picTmp.Copy 0
      alb.DeletePicture picTmp
      set picTmp = Nothing   
    'end if
  end if
end sub

' ------------------------------------------------------------------------------------
sub CopyInfo( byref picOrg, byref picDest )

  picDest.sComment = picOrg.sComment
  ' Get the keywords
  dim i, j, s, kw, kD, nbKW, tabKW()
  nbKW = alb.nbKeyword
  redim tabKW(nbKW)
  for i = 0 to nbKW-1
    set kw = alb.getKeyword(i)
    tabKW(i) = kw.sName
  next

  ' Get the custom fields
  dim nbCF, tabCF(), tabCFType()
  nbCF = alb.nbCustomField
  redim tabCF(nbCF), tabCFType(nbCF)
  for i = 0 to nbCF-1
    set kw = alb.getCustomField(i)
    tabCF(i) = kw.sName
    tabCFType(i) = kw.nType
  next

  ' Copy the keywords from the reference picture
  for j = 0 to nbKW-1
    set kw = alb.getKeyword(j)
    if picOrg.HasKeyword( kw.sName ) then picDest.SetKeyword kw.sName, True
  next

  ' Copy the custom fields from the reference picture
  for j = 0 to nbCF-1
    set kw = alb.getCustomField(j)
    if kw.nType <> CF_STRING then
      kD = picOrg.GetCustomFieldDate( kw.sName )
      if kD <> 0 then picDest.SetCustomFieldDate kw.sName, kD
    else
      s = picOrg.GetCustomField( kw.sName )
      if len(s) > 0 then 
      picDest.SetCustomField kw.sName, s
'app.Trace s & "  " & picDest.GetCustomField( kw.sName )
      end if
    end if
  next
end sub

' ------------------------------------------------------------------------------------
sub PrintInfo( byref picRef, byref pic )
  if sStampInfo = "" then exit sub
  
  pic.Load False	' Force picture reloading
  
  ' Write the text at the bottom of the picture
  dim rect
  set rect = CreateObject("MyAlbum.rect")
  rect.x = 0
  rect.y = 0
  rect.w = pic.w
  rect.h = pic.h
  pic.drawText alb.ExpandMacro( picRef, sStampInfo ), rect, font, textColor, textBkColor, DT_SINGLELINE or DT_BOTTOM or DT_CENTER or DT_NOPREFIX
  set rect = Nothing
end sub

' ------------------------------------------------------------------------------------
sub GetPictureOffset( byref pix, byref xP, byref yP)
  dim s, T
  s = pix.GetCustomField( "Offset" )
  if s = "" then
    s = "0,0"
  else
    app.Trace " Décallage courant = " & s
  end if  
  T = Split( s, ",", -1, 1 )
  xP = CInt(T(0))
  yP = CInt(T(1))
end sub

' ------------------------------------------------------------------------------------
function min( a, b )
  if a < b then
    min = a
  else
    min = b
  end if
end function

function max( a, b )
  if a > b then
    max = a
  else
    max = b
  end if
end function