' ------------------------------------------------------------------------------------ ' StereoscopeApplet.vbs ' ' This script will build a web page for viewing stereo photographs using the ' Stereoscope Java Applet from Andreas Petersik (http://www.stereofoto.de/sapplet/). ' Select pairs of L/R pictures in the album and launch the script. ' Download first the applet from Andreas Petersik's site. ' Modify the values in the block of const(ants) to suits your configuration and needs. ' ------------------------------------------------------------------------------------ Option Explicit app.ClearTrace 'const sOutputPath = "M:\Images\Stéréo\HTML3" ' Replace by your output folder const stereoscopePath = "M:\Images\Stéréo\stereoscope.jar" ' Replace by the full path of the applet 'const stereoscopePath = "D:\Webpages\3D\stereoscope.jar" ' Replace by the full path of the applet const titleText = "%AN" ' Display String for page title const pictureText = "%FN (%FK KB)" ' Display String for the picture comment const stereoType = "parallel" ' Default viewing mode in the applet const previewSize = 120 ' Size of the preview picture (set to 0 to use thumbnail size) const previewSubFolder = "Thumbnails" ' Sub-folder where the preview pictures will be saved const columns = 4 ' Columns in the table Const ForReading = 1, ForWriting = 2 Dim alb, pic, pic1, pic2, picNew, fso, f, k, nbP, nPrevSize, sPicFile1, sPicFile2 Dim nbPic, i, w, kR, nbSelPic, sFirstPic, s, sCmt, sFile, rcCrop, sPreviewFile set alb = app.GetCurrentAlbum Dim outputFileName, sTitle, sOutputPath ' Using the album folder as the default output folder sOutputPath = alb.ExpandMacro( Nothing, "%Af" ) sOutputPath = app.GetFilename( "Select the output folder (default is the album folder)", 2, sOutputPath, "", 0 ) if sOutputPath <> "" then app.trace "Output folder is: " & sOutputPath, -1, TRACE_INFORMATION outputFileName = "Stereo.html" 'InputBox( "Please enter the name of the HTML file to create", "StereoscopeApplet generator", "StereoscopeApplet.html") outputFileName = sOutputPath & "\" & outputFileName app.Trace "Output file = " & outputFileName, -1, TRACE_INFORMATION nPrevSize = previewSize if nPrevSize = 0 then nPrevSize = alb.nThumbSize ' Copy of the Stereoscope Applet java archive in the output folder Set fso = CreateObject("Scripting.FileSystemObject") set f = fso.GetFile( stereoscopePath ) f.copy sOutputPath & "\" & "stereoscope.jar" set f = Nothing nbPic = alb.nbPicture nbSelPic = alb.nbSelectedPicture app.Trace "Pictures selected in this album: " & nbSelPic, -1, TRACE_INFORMATION Set f = fso.OpenTextFile( outputFileName, ForWriting, True) f.WriteLine "" f.WriteLine "" f.WriteLine "" sTitle = alb.ExpandMacro( Nothing, titleText ) f.WriteLine " " & sTitle & "" f.WriteLine " " f.WriteLine " " f.WriteLine " " f.WriteLine "" f.WriteLine "" f.WriteLine "

" & sTitle & "

" f.WriteLine "
" if columns > 0 then f.WriteLine "" set pic1 = Nothing set pic2 = Nothing nbP = 0 kR = 0 ' Process each selected picture for i=0 to nbPic-1 Set pic = alb.GetPicture(i) if pic.bSelected then if pic1 is Nothing then set pic1 = pic elseif pic2 is Nothing then set pic2 = pic app.Trace "Generating pair #" & nbP+1, -1, TRACE_INFORMATION app.Trace " Processing pictures '" & pic1.sShortFileName & "' and '" & pic2.sShortFileName & "'..." ' If cropping is activated and set for the first picture, we create the preview picture using the ' first picture thumbnail, otherwise take the selected part and resize it to the thumnail size. sFile = pic1.sShortFileName k = InStrRev( sFile, "." ) sPreviewFile = previewSubFolder & "\" & left( sFile, k-1 ) & "_pv.jpg" sFile = sOutputPath & "\" & sPreviewFile app.Trace " Saving preview picture " & sFile set rcCrop = pic1.rcCrop if alb.nCropMode <> CropMode_Crop or rcCrop.w = 0 then if nPrevSize = alb.nThumbSize then pic1.copy -1 alb.paste sFile set picNew = alb.GetPicture( alb.nbPicture-1 ) else pic1.ConvertAndResize sFile, TYPE_JPEG, nPrevSize, nPrevSize set picNew = alb.AddPicture( sFile ) end if else pic1.ConvertAndResize2 sFile, TYPE_JPEG, nPrevSize, nPrevSize, RM_BOUNDINGRECT, 0, 0 set picNew = alb.AddPicture( sFile ) end if set rcCrop = Nothing ' Copy the two pictures to the output folder sPicFile1 = CopyOrCrop( pic1 ) sPicFile2 = CopyOrCrop( pic2 ) if columns > 0 then if kR mod columns = 0 then if nbP > 0 then f.WriteLine "" f.WriteLine "" end if f.WriteLine "" kR = kR + 1 end if alb.DeletePicture picNew set picNew = Nothing set pic1 = Nothing set pic2 = Nothing nbP = nbP + 1 end if end if next if columns > 0 then f.WriteLine "" & vbcrlf & "
" end if f.WriteLine "" f.WriteLine " " f.WriteLine " " f.WriteLine " " f.WriteLine " " f.WriteLine " " f.WriteLine "

" f.WriteLine " " f.WriteLine " If you had a JAVA 1.1 enabled browser, you would see a stereoscopic image here!" f.WriteLine "
So you get a preview version only:" f.WriteLine "

" f.WriteLine " " f.WriteLine "

" f.WriteLine "" f.WriteLine "
" & alb.ExpandMacro( pic1, PictureText ) & "
" f.WriteLine "" if columns > 0 then f.WriteLine "

" f.WriteLine "
" f.WriteLine "" f.WriteLine "

" & vbcrlf & "
" & vbcrlf & "
Build with MyAlbum script
" f.WriteLine "" f.WriteLine "" f.Close app.Trace "" app.Trace nbP & " pairs of pictures processed.", -1, TRACE_INFORMATION app.Trace "HTML file generation complete !", -1, TRACE_OK ' Launch browser if nbP > 0 then app.Run outputFileName, True, 0 end if ' No output folder selected '------------------------------------------------------ function CopyOrCrop( byref pic ) dim rcCrop, fPic, picT, sOldFile, sNewFile set rcCrop = pic.rcCrop if alb.nCropMode <> CropMode_Crop or rcCrop.w = 0 then ' No cropping rect defined, copy the picture file sOldFile = alb.ExpandMacro( pic, "%RP" ) sNewFile = sOutputPath & "\" & pic.sShortFileName 'if sNewFile <> sOldFile then ' set fPic = fso.GetFile( sOldFile ) ' app.Trace " Copying picture " & pic.sShortFileName & " in " & sOutputPath ' fPic.Copy sNewFile ' set fPic = Nothing 'else app.Trace " Using original file for picture " & pic.sShortFileName 'end if CopyOrCrop = sOldFile else app.Trace " Cropping picture " & pic.sShortFileName & " in " & sOutputPath & vbTab & "(" & rcCrop.x & "," & rcCrop.y & ") [" & rcCrop.w & "x" & rcCrop.h & "]" pic.CopyRect rcCrop.x, rcCrop.y, rcCrop.x+rcCrop.w, rcCrop.y+rcCrop.h, 0 sNewFile = sOutputPath & "\" & pic.sShortFileName k = InStrRev( sNewFile, "." ) sNewFile = Left( sNewFile, k ) & "_rz" & Mid( sNewFile, k ) alb.Paste sNewFile set picT = alb.GetPicture( alb.nbPicture - 1 ) alb.DeletePicture picT set picT = Nothing CopyOrCrop = sNewFile end if set rcCrop = Nothing end function