' ------------------------------------------------------------------------------------ ' This is a simple HTML generator written in VBScript ' ' It uses the current album or a user specified album to build a Framed HTML file. ' This file processes all the selected pictures. ' ------------------------------------------------------------------------------------ Option Explicit ' To run this script outside of MyAlbum, un-comment the 2 following lines: 'dim app 'set app = CreateObject("MyAlbum.Application") app.ClearTrace Dim alb, pic if GetAlbum( alb ) then MsgBox( "This script will add the selected pictures to a Framed HTML page. Please select OK to continue") MsgBox( "If you want alternate text to show when mouse is over the thumbnail, First fill out the Information field for each pic in the album by right mouse clicking on the pic and selecting Information. Please select OK to continue") 'app.Trace "Output file = " & outputFileName Dim outputFileName outputFileName = InputBox( "Please enter the name of the INDEX HTML file to create", "Simple HTML generator", "index.html") app.Trace "Output file = " & outputFileName Dim backgroundcolor backgroundcolor = InputBox( "Please enter the color for the background, choices are: black, white, green, blue, red", "Simple HTML generator", "white") app.Trace "Background Color = " & backgroundcolor Dim fontcolor fontcolor = InputBox( "Please enter the color for the font, choices are: black, white, green, blue, red", "Simple HTML generator", "black") app.Trace "Font Color = " & fontcolor Dim titlename titlename = InputBox( "Please enter the Title of the web page to create", "Simple HTML generator", alb.sAlbumTitle ) app.Trace "Web Page Title = " & titlename Dim maintext maintext = InputBox( "Please enter a text description to display in the main window of the web page to create", "Simple HTML generator", "description" ) app.Trace "Web Page Description = " & maintext Const ForReading = 1, ForWriting = 2 Dim fso, f, m, picPath Set fso = CreateObject("Scripting.FileSystemObject") ' This part works and picPath is equal to the absolute path and pic file name. ' First get the path relative to the album Set pic = alb.GetVisiblePicture(0) picPath = alb.ExpandMacro( pic, "%RP" ) app.Trace "The path for the first picture is " & picPath dim k, pathstring k = instrrev(picPath,"\") ' Search for the last back-slash pathstring = left(picPath, k) app.Trace "The pathstring is " & pathstring Set f = fso.OpenTextFile( pathstring & outputFileName, ForWriting, True) f.WriteLine "" f.WriteLine "" f.WriteLine " " f.WriteLine " " f.WriteLine " " & titlename & "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "<BODY TEXT=" & fontcolor & " BGCOLOR=" & backgroundcolor & ">" f.WriteLine "<p>This page requires a frames capable browser</p>" f.WriteLine "</body>" f.WriteLine "" f.WriteLine "" f.WriteLine "" app.Trace "Page " & outputfilename & " created " f.Close ' ' This section creates the top.html file ' ' Set topFileName = top.html Set f = fso.OpenTextFile( pathstring & "top.html", ForWriting, True) f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "top" f.WriteLine "" f.WriteLine "" f.WriteLine "

" & titlename & "

" f.WriteLine "" f.WriteLine "" app.Trace "Page top.html created " f.Close ' ' This section creates the main.html file ' Set f = fso.OpenTextFile( pathstring & "main.html", ForWriting, True) f.WriteLine "" f.WriteLine "" f.WriteLine "main" f.WriteLine "" f.WriteLine "" f.WriteLine "



" f.WriteLine "" f.WriteLine "" f.WriteLine "
" f.WriteLine "
" & maintext & "

" f.WriteLine "
" f.WriteLine "" f.WriteLine "" app.Trace "Page main.html created " f.Close ' ' ' This section creates the menu.html file ' Set f = fso.OpenTextFile( pathstring & "menu.html", ForWriting, True) f.WriteLine "" f.WriteLine "" f.WriteLine " " & titlename & "" f.WriteLine "" f.WriteLine "" f.WriteLine "" f.WriteLine "Click Here
" f.WriteLine "
" app.Trace "Page menu.html being created " ' ' ' The following lines go to the creation of the MENU files ' ' ' Process each selected picture Dim nbPic, i nbPic = alb.nbVisiblePicture app.Trace "Pictures to process in this album: " & nbPic f.WriteLine "
" ' Everything is centered for i=0 to nbPic-1 Set pic = alb.GetVisiblePicture(i) if pic.bSelected then f.WriteLine "" f.WriteLine "" ' Important : convert the filename so it is web-compatible Dim picFile, thFile ' First get the path relative to the album picFile = alb.ExpandMacro( pic, "%RP" ) ' Build the name of the thumbnail assuming "_th" is appended ' to the name and its type is the same as the original picture k = instrrev( picFile, "." ) thFile = left(picFile, k-1) & "_th" & mid(picFile, k) f.WriteLine "" f.WriteLine "" f.WriteLine "
" ' Build the drop-down list with the picture info picFile = pic.sShortFileName 'f.WriteLine "" 'f.WriteLine " " 'f.WriteLine " " 'f.WriteLine " " 'f.WriteLine "
" 'f.WriteLine "
" f.WriteLine "" 'f.WriteLine "
" 'f.WriteLine "
" f.WriteLine "
" app.Trace "File " & picFile & " added" else app.Trace "File " & picFile & " skipped" end if next f.WriteLine "
" f.WriteLine "Built with MyAlbum script" f.WriteLine "
Created by:" f.WriteLine "
mpilihp@yahoo.com" f.WriteLine "
With help by:" f.WriteLine "
pierre.meindre@wanadoo.fr" f.WriteLine "
With code from:" f.WriteLine "
r.p.feria@ieee.org" f.WriteLine "
Steve@sdean.demon.co.uk" f.WriteLine "" f.WriteLine "" f.Close app.Trace nbPic & " picture processed." app.Trace "HTML file generation complete !" app.Trace "This script creates a web page that uses thumbnail pictures in the menu." app.Trace "Create these from My Album Tools -> Export Album menu option." app.Trace "Select -Save Thumbnails- then set Output Directory to where this albums images are located, and prest Start!" MsgBox( "Please read the last three lines in trace for instructions on completing this WEB page." & vbcrlf & "Please select OK to continue") ' Launch browser app.Run pathstring & outputFileName, True, 1 else app.Trace "No album to process, exiting !" end if ' ******************************************************************************** ' * ' * GetAlbum : get the current album or prompt the user to select one ' * Function GetAlbum( byref alb ) GetAlbum = True ' First try to use the current album set alb = app.GetCurrentAlbum if alb is nothing then ' No album is open dim albFile albFile = InputBox( "Please enter the name of the album to process", "Simple HTML generator", "") set alb = app.LoadAlbum( albFile ) if alb is Nothing then GetAlbum = False end if end if End Function