' ------------------------------------------------------------------------------------ ' PanoramaApplet.vbs ' ' This script will build a web page for viewing panorama pictures using the ' ptviewer Java Applet from Professor Helmut Dersch (www.fh-furtwangen.de/~dersch/). ' Download first the applet from: http://www.path.unimelb.edu.au/~dersch/ or from ' http://www.fsoft.it/panorama/ptviewer.htm ' Modify the values in the block of const(ants) to suits your configuration and needs. ' ' ------------------------------------------------------------------------------------ Option Explicit app.ClearTrace 'const ptviewerPath = "D:\HTML\Pano\ptviewer3.1.2.jar" ' Replace by the full path of the applet const ptviewerPath = "M:\Images\Panorama\ptviewer.jar" ' Replace by the full path of the applet const titleText = "%AN" ' Display String for page title const pictureText = "%C8 - %FC (%FK KB)" ' Display String for the picture link (in the selection list) const commentText = "%C8 - %FC
%C1 %LE[%C2,5]" ' Display String for the picture comment const bShowInstruction = True ' Display a short text on how to use the applet at the bottom of the page const pageField = "Lieu" ' const hotSpotField = "hotspots" ' Dim alb, pic, picNew, fso, f, k, nbP set alb = app.GetCurrentAlbum Dim sOutputPath, outputFileName, outputBaseFileName, sTitle ' 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 ) app.trace "Output folder is: " & sOutputPath, -1, TRACE_INFORMATION outputBaseFileName = "index.htm" 'InputBox( "Please enter the name of the HTML file to create", "StereoscopeApplet generator", "StereoscopeApplet.html") outputFileName = sOutputPath & "\" & outputBaseFileName app.Trace "Output file = " & outputFileName, -1, TRACE_INFORMATION ' Copy of the ptviewer Applet java archive in the output folder Set fso = CreateObject("Scripting.FileSystemObject") set f = fso.GetFile( ptviewerPath ) f.copy sOutputPath & "\" & "ptviewer.jar" set f = Nothing Const ForReading = 1, ForWriting = 2 Dim nbPic, i, w, kR, nbSelPic, sFirstPic, s, sCmt, sFile, rcCrop, sPreviewFile, sLine nbPic = alb.nbPicture nbSelPic = alb.nbSelectedPicture app.Trace "Pictures selected in this album: " & nbSelPic, -1, TRACE_INFORMATION ' First find all the pages Dim tabPages(), tabPicPages(), nbPages, bAddPage, j nbPages = 0 if pageField <> "" then for i=0 to nbPic-1 Set pic = alb.GetPicture(i) if not pic is Nothing and pic.bSelected then s = pic.GetCustomField( pageField ) if s <> "" then bAddPage = True for j = 0 to nbPages-1 if tabPages(j) = s then tabPicPages(j) = tabPicPages(j) + 1 bAddPage = False end if next if bAddPage then nbPages = nbPages + 1 redim Preserve tabPages(nbPages) redim Preserve tabPicPages(nbPages) tabPages(nbPages-1) = s tabPicPages(nbPages-1) = 1 end if end if end if next app.Trace "Found " & nbPages & " pages:" for j = 0 to nbPages-1 app.Trace vbTab & tabPages(j) & vbtab & tabPicPages(j) & " pictures" next end if 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 "

" f.WriteLine "Please wait!" 'f.WriteLine " " f.WriteLine "

" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine " " f.WriteLine " " ' Process each selected picture k = 0 Dim sFileName, sHP for i=0 to nbPic-1 Set pic = alb.GetPicture(i) if pic.bSelected and (pic.lStatus and &hff) = TYPE_JPEG then s = pic.GetCustomField( "hfov" ) if s <> "" and s <> "360" then s = " {pfov=" & s & "}" else if s = "360" then 'and pic.w = 2*pic.h then s = " {fov=100}" else s = "" end if end if app.Trace " Processing picture '" & pic.sShortFileName & "'..." sFileName = app.HTMLFileName( alb.ExpandMacro( pic, "%RP" ), sOutputPath ) if Left( sFileName, 2 ) = ".." or InStr( sFileName, ":///" ) <> 0 then app.Trace vbTab & "Caution: PTViewer may not be able to load this picture.", -1, TRACE_WARNING sHP = buildHotSpot( pic ) if sHP <> "" then s = s & " " & sHP f.WriteLine " " k = k + 1 end if next f.WriteLine "" 'f.WriteLine "
" f.WriteLine "" f.WriteLine "

" 'f.WriteLine "" 'f.WriteLine "
" f.WriteLine "" f.WriteLine "" & vbCRLF if bShowInstruction then f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "

Instructions:
" f.WriteLine " " f.WriteLine " Click and move the mouse to pan and tilt. " f.WriteLine " While panning, use the Ctrl and/or Shift keys to zoom in and out. " f.WriteLine " Alternatively, use the arrow keys for panning and tilting in fixed increments. " f.WriteLine " " f.WriteLine "	" f.WriteLine " Use + and -, or > and < keys to zoom in fixed increments. " f.WriteLine " Press the space bar to make show or hide the hotspots. " f.WriteLine " While over hotspot, click the mouse or press Enter to jump to link. " f.WriteLine "" f.WriteLine "

" end if f.WriteLine "

" & vbcrlf & "Built with MyAlbum script" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.Close app.Trace "" app.Trace nbP & " pictures processed." app.Trace "HTML file generation complete !", -1, TRACE_GREENDOT ' Launch browser ''''if nbP > 0 then app.Run outputFileName, True, 0 ' ------------------------------------------------------------------------------------ function buildHotSpot(pic) buildHotSpot = "" dim s, iSpot, TSpot, i, k, TF s = pic.GetCustomField( hotSpotField ) iSpot = 0 TSpot = Split( s, ";", -1, 1 ) k = UBound(TSpot) if k < 0 then exit function for i = 0 to k 'app.Trace TSpot(i), &hff0000 TF = Split( TSpot(i), ",", -1, 1 ) if UBound(TF) = 2 then 'if iSpot = 0 then buildHotSpot = "" buildHotSpot = buildHotSpot & " {hotspot" & iSpot & "=X" & TF(1) & " Y" & TF(2) & " u'javascript:selectThisPicture(" & findPicNum(TF(0)) & ")'}" iSpot = iSpot + 1 else app.Trace "Caution: Badly written hotspot: '" & TSpot(i) & "'", 255, TRACE_WARNING end if next end function ' ------------------------------------------------------------------------------------ function findPicNum(picName) findPicNum = 0 dim i, pic for i=0 to nbPic-1 Set pic = alb.GetPicture(i) if pic.bSelected then if picName = pic.sShortFileName then exit function findPicNum = findPicNum + 1 end if next app.Trace "Caution: Cannot find hotspot picture: '" & picName & "'", 255, TRACE_WARNING end function