' ------------------------------------------------------------------------------------ ' SplitStereoPair.vbs ' This script will split a stereo pair picture in a Left and a Right picture. ' The pair will be cut in the middle of the picture. ' Parallel viewing is assumed when naming the left and right pictures (change the ' value of the bParallel constant to process crossed-view pictures). ' ------------------------------------------------------------------------------------ Option Explicit ' Define the keyword that will be assigned to the splitted pictures ' (define as "" if no keyword assignment is needed) const sKeyWord = "Paires" const bParallel = True dim alb, pic, newPic, i, nb, xSize, kP, k, sFileName, sNewFile, nbNewPic, xP app.ClearTrace set alb = app.GetCurrentAlbum if not alb is nothing and alb.nbSelectedPicture > 0 then ' Retrives the selected pairs in the album nb = alb.nbPicture set pic = alb.GetPicture( 0 ) while not pic is Nothing if pic.bSelected then app.trace "Spliting picture " & pic.sShortFileName & "...", -1, TRACE_INFORMATION k = pic.num if pic.w mod 2 = 1 then xSize = (pic.w - 1) / 2 else xSize = pic.w / 2 end if 'app.Trace xSize ' Process left part sFileName = alb.ExpandMacro( pic, "%RP" ) k = InStrRev( sFileName, "." ) sFileName = Left( sFileName, k-1 ) nbNewPic = 0 xP = 0 if not bParallel then xP = xSize if pic.CopyRect( xP, 0, xP+xSize, pic.h, 0 ) then sNewFile = sFileName & "_L.jpg" app.Trace " Saving left picture as '" & sNewFile & "'..." alb.Paste sNewFile ' The new picture is at the end of the album, move it next to the original picture set newPic = alb.GetPicture( alb.nbPicture-1 ) alb.MovePicture newPic, alb.CvtNumPic( pic.num, False ), True if sKeyWord <> "" then newPic.SetKeyword sKeyWord, True nbNewPic = nbNewPic + 1 else app.Trace "Cannot copy first picture", 255, TRACE_ERROR end if ' and the right part xP = xSize if not bParallel then xP = 0 if pic.CopyRect( xP, 0, xP+xSize, pic.h, 0 ) then sNewFile = sFileName & "_R.jpg" app.Trace " Saving right picture as '" & sNewFile & "'..." alb.Paste sNewFile set newPic = alb.GetPicture( alb.nbPicture-1 ) alb.MovePicture newPic, alb.CvtNumPic( pic.num, False )+1, True if sKeyWord <> "" then newPic.SetKeyword sKeyWord, True nbNewPic = nbNewPic + 1 else app.Trace "Cannot copy second picture", 255, TRACE_ERROR end if set newPic = Nothing ' Album has now (normally) two more pictures nb = nb + nbNewPic end if set pic = pic.next wend alb.redraw else MsgBox "No picture selected!" end if app.Trace "Done!!!", -1, TRACE_GREENDOT