' ------------------------------------------------------------------------------------
' This is a simple HTML generator written in VBScript
'
' It uses the current album or a user specified album to build a basic HTML file.
' As the HTML file can be very memory consumming, the number of pictures
' processed is limited to 20.
' The pictures are displayed half size.
' ------------------------------------------------------------------------------------
Option Explicit
' To run this script outside of MyAlbum, un-comment the 2 following lines:
'dim app
'set app = CreateObject("MyAlbum.Application")
app.ClearTrace
const PICTURESIZE=50 ' Picture are resized at 50% of their size
Dim alb, pic
if GetAlbum( alb ) then
Dim outputFileName
outputFileName = InputBox( "Please enter the name of the HTML file to create", "Simple HTML generator", "Test.html")
app.Trace "Output file = " & outputFileName
Const ForReading = 1, ForWriting = 2
Dim fso, f, m
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile( outputFileName, ForWriting, True)
f.WriteLine ""
f.WriteLine ""
f.WriteLine ""
f.WriteLine " "
f.WriteLine " "
f.WriteLine " " & alb.sAlbumTitle & " - " & alb.sAlbumComment & ""
f.WriteLine ""
f.WriteLine ""
f.WriteLine "" & alb.sAlbumTitle & "
"
f.WriteLine "" & alb.sAlbumComment & "
"
' Process each picture
Dim nbPic, i, w
nbPic = alb.nbPicture
app.Trace "Pictures in this album: " & nbPic
if nbPic > 25 then
if vbNo = MsgBox( "This album has a lot of pictures." & chr(13) & "Generate the file for all of them or only the 20 first ones ?", 4, "Big album !") then
nbPic = 20
end if
end if
f.WriteLine "
" ' Everything is centered
for i=0 to nbPic-1
Set pic = alb.GetPicture(i)
' Important : convert the filename so it is web-compatible
Dim albFile
' First get the path relative to the album
albFile = alb.ExpandMacro( pic, "%RP" )
f.Write "![]()
"
f.WriteLine "
" & pic.sComment & "
"
next
f.WriteLine ""
f.WriteLine "Build with MyAlbum script"
f.WriteLine ""
f.WriteLine ""
f.Close
app.Trace nbPic & " picture processed"
app.Trace "HTML file generation complete !"
' Launch browser
app.Run outputFileName, True, 0
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 typeName(alb) = "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 typeName(alb) = "Nothing" then
GetAlbum = False
end if
end if
End Function