PhotoPageGenerator v2.3 - Visual Basic Source Code

Back to: Main Programming Page

This is a program I wrote to generate some html code to automate the making of photo pages. It will read a directory to get all of the images, write the html code to put them in thumbnails, and generate a webpage for each photo (with navigation links and a handy-dandy javascript that dynamically resizes the image to fit the window), or a list to put in a drop-down box for a slideshow. You can even generate different galleries for the images in a directory. There is also a readme file included in the zip archive with detailed directions on how to use the program. Note that the code it generates is to work with the format of my Photo Pages, but you could easily edit the code to make it fit whatever format you wanted. This program uses a module written by David Crowell to read in the image sizes.

 

Previous Versions:

 

Source Code:

Form1:
Form1 Screenshot 
'Instructions:
'1. Make sure all input boxes are set up properly.  It's usually easiest to do that from
'the VB editor, and save it, so that in case there are any bugs, you don't have to
'input them all over again.
'
'2. Hit the Read Graphics Directory button.  This will output text into the "File List"
'box of the form needed for the program.
'
'3. Optional - copy and paste that text into a separate text file for archiving.  You can
'rearrange the order of pictures here, add the captions for the index page, or modify the
'captions for the photo pages.
'
'4. Optional - Copy and paste the list from the separate text file into the "File List" box
'
'5. Hit the "Create Page for Each Photo..." box.  This will create the individual html
'photo pages.  It will also output the necessary html code for the index page into the
'"HTML Output to Copy and Paste" box.  Copy and paste that code into the index page.

Option Explicit

Dim ImageList() As String
Dim ctr As Integer
Dim ctr2 As Integer
'Dim ImageName As String
Dim DirectoryName As String
Dim NumberImages As Integer
Dim HTMLPrefix As String
Dim ImageWidth As Integer
Dim ImageHeight As Integer
Dim IniFilename As String
Dim IniFileDir As String
Dim WidthString As String
Dim HeightString As String
Dim IndentString As String
Dim OutputString As String

Private Sub Form_Load()
IniFileDir = App.Path
CommonDialog1.InitDir = IniFileDir

Call ReadINI("PPGDefault.ini")
End Sub

Private Sub ReadINI(Filename)
  Dim InputVar As String

  If Len(Filename) > 0 Then 'If user hits cancel, no Filename is returned
    Open Filename For Input As #1
    Line Input #1, InputVar
    If InputVar = "PPG2.1" Then
      Line Input #1, InputVar
      TextFileType.Text = Right(InputVar, Len(InputVar) - 9)

      Line Input #1, InputVar
      TextGraphicsPath.Text = Right(InputVar, Len(InputVar) - 13)
    
      Line Input #1, InputVar
      TextThumbnailPath.Text = Right(InputVar, Len(InputVar) - 14)
    
      Line Input #1, InputVar
      TextHTMLPrefix.Text = Right(InputVar, Len(InputVar) - 11)
    
      Line Input #1, InputVar
      TextIndentValue.Text = Right(InputVar, Len(InputVar) - 12)
    
      Line Input #1, InputVar
      TextCaptionLines.Text = Right(InputVar, Len(InputVar) - 13)
    
      Line Input #1, InputVar
      TextPrefixLength.Text = Right(InputVar, Len(InputVar) - 13)
    
      Line Input #1, InputVar
      TextIndexLink.Text = Right(InputVar, Len(InputVar) - 10)
    
      Line Input #1, InputVar
      TextPhotoPageTitle.Text = Right(InputVar, Len(InputVar) - 15)
    
      Line Input #1, InputVar
      TextGraphicsPathInput.Text = Right(InputVar, Len(InputVar) - 18)
    
      Line Input #1, InputVar
      TextThumbnailsPathInput.Text = Right(InputVar, Len(InputVar) - 20)
    
      Line Input #1, InputVar
      TextThumbnailSuffix.Text = Right(InputVar, Len(InputVar) - 16)
    ElseIf InputVar = "PPG2.2" Then
      Line Input #1, InputVar
      TextFileType.Text = Right(InputVar, Len(InputVar) - 9)

      Line Input #1, InputVar
      TextGraphicsPath.Text = Right(InputVar, Len(InputVar) - 13)
    
      Line Input #1, InputVar
      TextThumbnailPath.Text = Right(InputVar, Len(InputVar) - 14)
    
      Line Input #1, InputVar
      TextHTMLPrefix.Text = Right(InputVar, Len(InputVar) - 11)
    
      Line Input #1, InputVar
      TextIndentValue.Text = Right(InputVar, Len(InputVar) - 12)
    
      Line Input #1, InputVar
      TextCaptionLines.Text = Right(InputVar, Len(InputVar) - 13)
    
      Line Input #1, InputVar
      TextPrefixLength.Text = Right(InputVar, Len(InputVar) - 13)
    
      Line Input #1, InputVar
      TextIndexLink.Text = Right(InputVar, Len(InputVar) - 10)
    
      Line Input #1, InputVar
      TextPhotoPageTitle.Text = Right(InputVar, Len(InputVar) - 15)
    
      Line Input #1, InputVar
      TextGraphicsPathInput.Text = Right(InputVar, Len(InputVar) - 18)
    
      Line Input #1, InputVar
      TextThumbnailsPathInput.Text = Right(InputVar, Len(InputVar) - 20)
    
      Line Input #1, InputVar
      TextThumbnailSuffix.Text = Right(InputVar, Len(InputVar) - 16)
    
      Line Input #1, InputVar
      If Right(InputVar, 4) = "True" Then
        CheckIntermediate.Value = 1
      Else
        CheckIntermediate.Value = 0
      End If
    
      Line Input #1, InputVar
      TextIntermediateSuffix.Text = Right(InputVar, Len(InputVar) - 19)
    
    Else
      MsgBox "Invalid .ini file.  Please select an appropriate file."
    End If
  End If
  Close #1
End Sub

Private Sub Command1_Click()
  TextFileList.Text = ""
End Sub

Private Sub CommandSaveINI_Click()
'IniFilename = CommonDialog1.GetOpenFilename("Text Files (*.txt), *.txt")

CommonDialog1.Filter = "*.ini"
CommonDialog1.ShowSave

If CommonDialog1.Filename <> "" Then
  IniFilename = CommonDialog1.Filename
  Open IniFilename For Output As #1
    Print #1, "PPG2.2"
    Print #1, "FileType=" & TextFileType.Text
    Print #1, "GraphicsPath=" & TextGraphicsPath.Text
    Print #1, "ThumbnailPath=" & TextThumbnailPath.Text
    Print #1, "HTMLPrefix=" & TextHTMLPrefix.Text
    Print #1, "IndentValue=" & TextIndentValue.Text
    Print #1, "CaptionLines=" & TextCaptionLines.Text
    Print #1, "PrefixLength=" & TextPrefixLength.Text
    Print #1, "IndexLink=" & TextIndexLink.Text
    Print #1, "PhotoPageTitle=" & TextPhotoPageTitle.Text
    Print #1, "GraphicsPathInput=" & TextGraphicsPathInput.Text
    Print #1, "ThumbnailsPathInput=" & TextThumbnailsPathInput.Text
    Print #1, "ThumbnailSuffix=" & TextThumbnailSuffix.Text
    If CheckIntermediate Then
      Print #1, "CheckIntermediate=True"
    Else
      Print #1, "CheckIntermediate=False"
    End If
    Print #1, "IntermediateSuffix=" & TextIntermediateSuffix.Text
  Close #1
  MsgBox "Current Configuration Saved as " & IniFilename
End If
End Sub

Private Sub CommandOpenINI_Click()
  CommonDialog1.Filter = "*.ini"
  CommonDialog1.ShowOpen
  
  IniFilename = CommonDialog1.Filename
  Call ReadINI(IniFilename)
End Sub

Private Sub CommandClearTextDebug_Click()
  TextDebug.Text = ""
End Sub

Private Sub CommandReadGraphicsDirectory_Click()
  Dim a As Single
  Dim ImageName As String
  Dim ThumbName As String
  Dim ThumbSuf As String
  Dim AltText As String
  Dim TestChar As String
  Dim PrefixLength As Integer
  
  ctr = 0
  DirectoryName = TextGraphicsPathInput.Text
  
  TextFileList.Text = ""
  
  PrefixLength = Val(TextPrefixLength.Text)
  ThumbSuf = TextThumbnailSuffix.Text
  
  ImageName = "START"
  
  ctr = ctr + 1
  ImageName = Dir(DirectoryName + TextFileType.Text)
  
  TextCurrentPhoto.Text = ImageName
  
  ThumbName = Left(ImageName, (Len(ImageName) - 4)) + ThumbSuf + Right(ImageName, 4)
  
  AltText = Mid(ImageName, 1, (Len(ImageName) - 4))
  AltText = Right(AltText, (Len(AltText) - PrefixLength))
  
  For ctr2 = 1 To Len(AltText)
    TestChar = Mid(AltText, ctr2, 1)
    If TestChar = "_" Then
      Mid(AltText, ctr2, 1) = " "
    End If
  Next ctr2
  
  TextFileList.Text = TextFileList.Text + "image=""" + ImageName + """" + vbCrLf
  TextFileList.Text = TextFileList.Text + "thumb=""" + ThumbName + """" + vbCrLf
  TextFileList.Text = TextFileList.Text + "alt=""" + AltText + """" + vbCrLf
  For ctr2 = 1 To Val(TextCaptionLines.Text)
    TextFileList.Text = TextFileList.Text + "<br>" + vbCrLf
  Next ctr2
  
  Do Until ImageName = ""
    DoEvents
    ctr = ctr + 1
    ImageName = Dir
    
    TextCurrentPhoto.Text = ImageName
    
    If ImageName <> "" Then
      ThumbName = Left(ImageName, (Len(ImageName) - 4)) + ThumbSuf + Right(ImageName, 4)
    
      AltText = Mid(ImageName, 1, (Len(ImageName) - 4))
      AltText = Right(AltText, (Len(AltText) - PrefixLength))
        
      For ctr2 = 1 To Len(AltText)
        TestChar = Mid(AltText, ctr2, 1)
        If TestChar = "_" Then
          Mid(AltText, ctr2, 1) = " "
        End If
      Next ctr2
        
      TextFileList.Text = TextFileList.Text + vbCrLf
      TextFileList.Text = TextFileList.Text + "image=""" + ImageName + """" + vbCrLf
      TextFileList.Text = TextFileList.Text + "thumb=""" + ThumbName + """" + vbCrLf
      TextFileList.Text = TextFileList.Text + "alt=""" + AltText + """" + vbCrLf
      For ctr2 = 1 To Val(TextCaptionLines.Text)
        TextFileList.Text = TextFileList.Text + "<br>" + vbCrLf
      Next ctr2
    End If
  Loop
  TextFileList.Text = TextFileList.Text + "END"
  'NumberImages = ctr - 1
End Sub


Private Sub CommandStartIndividualPages_Click()
  Dim HTMLFileName As String
  Dim PreviousHTMLFileName As String
  Dim NextHTMLFileName As String
  Dim Extension As String
  Dim DirectoryGraphics As String
  Dim DirectoryThumbnails As String
  Dim TestChar As String
  Dim IndexLink As String
  Dim ctr3 As Integer
  Dim FileList As String
  Dim ContinueProc As Boolean
  Dim NewEntry As Boolean
  Dim ImageName() As String
  Dim ThumbName() As String
  Dim FullResName() As String
  Dim AltText() As String
  Dim CaptionText() As String
  Dim FullImageName As String
  Dim OutputTextFile As String
  Dim PageTitle As String
  Dim TempSuffix As String
  Dim TempFullImageName As String
  Dim IntermediateSuffixLength As Integer

  DirectoryGraphics = TextGraphicsPathInput.Text
  DirectoryThumbnails = TextThumbnailsPathInput.Text
  
  IndexLink = TextIndexLink.Text
  PageTitle = TextPhotoPageTitle.Text
  HTMLPrefix = TextHTMLPrefix.Text

  IndentString = ""
  For ctr = 1 To Val(TextIndentValue.Text)
    IndentString = IndentString + " "
  Next ctr
  
  ContinueProc = True
  NewEntry = False
  FileList = TextFileList.Text
  IntermediateSuffixLength = Len(TextIntermediateSuffix.Text)
  
  ctr3 = 0
  Do Until ContinueProc = False
    ctr3 = ctr3 + 1
    If Left(FileList, 3) = "END" Then
      ContinueProc = False
    Else
      'Look for next entry
      Do Until NewEntry = True
        If Left(FileList, 5) = "image" Then
          NewEntry = True
        Else
          'Remove Current Line
          ctr = 1
          Do Until TestChar = Chr$(13)
            TestChar = Mid(FileList, ctr, 1)
            ctr = ctr + 1
          Loop
          FileList = Right(FileList, Len(FileList) - ctr)
        End If
      Loop
      NewEntry = False
      
      'Get Image Name, Remove Leading Directory, then trim FileList
      ReDim Preserve ImageName(ctr3)
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(FileList, ctr, 1)
        ctr = ctr + 1
      Loop
      ImageName(ctr3) = Mid(FileList, 8, ctr - 10)
      FileList = Right(FileList, Len(FileList) - ctr)

      ReDim Preserve ThumbName(ctr3)
      'Get Thumb Name, then trim FileList
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(FileList, ctr, 1)
        ctr = ctr + 1
      Loop
      ThumbName(ctr3) = Mid(FileList, 8, ctr - 10)
      FileList = Right(FileList, Len(FileList) - ctr)

      ReDim Preserve AltText(ctr3)
      'Get Alt Text, then trim FileList
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(FileList, ctr, 1)
        ctr = ctr + 1
      Loop
      AltText(ctr3) = Mid(FileList, 6, ctr - 8)
      FileList = Right(FileList, Len(FileList) - ctr)
      
      'Get Caption Text
      ReDim Preserve CaptionText(Val(TextCaptionLines.Text), ctr3)
      For ctr2 = 1 To Val(TextCaptionLines.Text)
            'Get Alt Text, then trim FileList
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(FileList, ctr, 1)
          ctr = ctr + 1
        Loop
        CaptionText(ctr2, ctr3) = Left(FileList, ctr - 2)
        FileList = Right(FileList, Len(FileList) - ctr)
      Next ctr2
      
      If CheckIntermediate Then
        ReDim Preserve FullResName(ctr3)
        TempSuffix = Right(ImageName(ctr3), 4)
        TempFullImageName = Left(ImageName(ctr3), Len(ImageName(ctr3)) - IntermediateSuffixLength - 4)
        
        FullResName(ctr3) = TempFullImageName + TempSuffix
      End If
      
      'End of Current Revision
    End If
  Loop
      
  NumberImages = ctr3 - 1
  
  For ctr = 1 To NumberImages
    DoEvents
    
    'Get Image Info
    FullImageName = DirectoryGraphics + ImageName(ctr)
    TextCurrentPhoto.Text = ImageName(ctr)
    Module1.ReadImageInfo (FullImageName)
    ImageWidth = Module1.Width
    ImageHeight = Module1.Height
    
    'Remove leading space from width & height
    WidthString = Str(ImageWidth)
    WidthString = Right(WidthString, Len(WidthString) - 1)
    HeightString = Str(ImageHeight)
    HeightString = Right(HeightString, Len(HeightString) - 1)
    
    'Open file for writing
    HTMLFileName = FullImageName
    'HTMLFileName = HTMLPrefix & Left(HTMLFileName, Len(HTMLFileName) - 3) & "html" 'remove .jpg or appropriate extension & add .html
    HTMLFileName = DirectoryGraphics & HTMLPrefix & Left(ImageName(ctr), Len(ImageName(ctr)) - 3) & "html"
    Open HTMLFileName For Output As #1
    
    'Write HTML to file
    Print #1, "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">"
    Print #1, "<html>"
    Print #1, ""
    Print #1, "<head>"
    Print #1, "<meta http-equiv=""Content-Language"" content=""en-us"">"
    Print #1, "<meta http-equiv=""Content-Type"" content=""text/html; charset=windows-1252"">"
    Print #1, "<title>" + PageTitle + "</title>"
    Print #1, ""
    Print #1, "<style TYPE=""text/css""><!--"
    Print #1, "  @import ""jrl.photos.css"";"
    Print #1, "--></style>"
    Print #1, ""
    Print #1, "<script language=""JavaScript"">"
    Print #1, "<!-- hide"
    Print #1, ""
    Print #1, "trueHeight = " & HeightString & ";"
    Print #1, "trueWidth = " & WidthString & ";"
    Print #1, ""
    Print #1, "trueAR = trueWidth / trueHeight;"
    Print #1, "toggleState = 0;"
    Print #1, "resizeTF = 1;"
    Print #1, ""
    Print #1, "window.onresize = ResizeImage;"
    Print #1, ""
    Print #1, "function ResizeImage() {"
    Print #1, ""
    Print #1, "  if (resizeTF == 1) {"
    Print #1, "    winWidth=document.all?document.body.clientWidth:window.innerWidth;"
    Print #1, "    winHeight=document.all?document.body.clientHeight:window.innerHeight;"
    Print #1, ""
    If CheckIntermediate Then
      Print #1, "    heightAvail = winHeight - 115;"
    Else
      Print #1, "    heightAvail = winHeight - 85;"
    End If
    Print #1, "    widthAvail = winWidth - 25;"
    Print #1, ""
    Print #1, "    aspectRatio = widthAvail / heightAvail;"
    Print #1, ""
    Print #1, "    if (aspectRatio > trueAR) {"
    Print #1, "      newPicHeight = heightAvail;"
    Print #1, "      newPicWidth = heightAvail * trueAR;"
    Print #1, "    } else {"
    Print #1, "      newPicWidth = widthAvail;"
    Print #1, "      newPicHeight = widthAvail / trueAR;"
    Print #1, "    }"
    Print #1, ""
    Print #1, "    if (newPicHeight < trueHeight) {"
    Print #1, "      document.images[""PhotoImage""].height = newPicHeight;"
    Print #1, "      document.images[""PhotoImage""].width = newPicWidth;"
    Print #1, "    } else {"
    Print #1, "      document.images[""PhotoImage""].height = trueHeight;"
    Print #1, "      document.images[""PhotoImage""].width = trueWidth;"
    Print #1, "    }"
    Print #1, "  }"
    Print #1, "}"
    Print #1, ""
    Print #1, ""
    Print #1, "function Toggle() {"
    Print #1, "  if (toggleState == 0) {"
    Print #1, "    resizeTF = 0;"
    Print #1, "    toggleState = 1;"
    Print #1, "    document.images[""PhotoImage""].height = trueHeight;"
    Print #1, "    document.images[""PhotoImage""].width = trueWidth;"
    Print #1, "    window.document.formMain.buttonToggle.value = 'Scale to Window';"
    Print #1, "  } else {"
    Print #1, "    resizeTF = 1;"
    Print #1, "    toggleState = 0;"
    Print #1, "    window.document.formMain.buttonToggle.value = 'Full Size';"
    Print #1, "    ResizeImage();"
    Print #1, ""
    Print #1, "    var watermarkID = DOMGetElement('watermark');"
    Print #1, "    PositionWatermark(watermarkID, 0, 0);"
    Print #1, "  }"
    Print #1, "}"
    Print #1, ""
    Print #1, ""
    Print #1, "function CalculateWatermarkPos() {"
    Print #1, "  xOffset = 140;"
    Print #1, "  yOffset = 45;"
    Print #1, ""
    Print #1, "  var watermarkID = DOMGetElement('watermark');"
    Print #1, ""
    Print #1, "  winWidth=document.all?document.body.clientWidth:window.innerWidth;"
    Print #1, "  winHeight=document.all?document.body.clientHeight:window.innerHeight;"
    Print #1, ""
    Print #1, "  if (document.all)                  xScrollOffset = document.body.scrollLeft;"
    Print #1, "  else if (document.getElementById)  xScrollOffset = window.pageXOffset;"
    Print #1, "  else if (document.layers)          xScrollOffset = window.pageXOffset;"
    Print #1, ""
    Print #1, "  if (document.all)                  yScrollOffset = document.body.scrollTop;"
    Print #1, "  else if (document.getElementById)  yScrollOffset = window.pageYOffset;"
    Print #1, "  else if (document.layers)          yScrollOffset = window.pageYOffset;"
    Print #1, ""
    Print #1, "  yPos = winHeight + yScrollOffset - yOffset;"
    Print #1, "  xPos = winWidth +xScrollOffset - xOffset;"
    Print #1, ""
    Print #1, "  if (yPos > trueHeight + 15)        yPos = trueHeight + 15;"
    Print #1, "  if (xPos > trueWidth - xOffset)    xPos = trueWidth - xOffset;"
    Print #1, ""
    Print #1, "  PositionWatermark(watermarkID, xPos, yPos);"
    Print #1, ""
    Print #1, "  if ((yScrollOffset == 0) && (xScrollOffset == 0) && (yPos == trueHeight + 15) && (xPos == trueWidth - xOffset) && (document.images[""PhotoImage""].width == trueWidth) && (document.images[""PhotoImage""].height == trueHeight)) {"
    Print #1, "    if (document.getElementById)     watermarkID.style.visibility = ""hidden"";"
    Print #1, "    else if (document.all)           watermarkID.style.visibility = ""hidden"";"
    Print #1, "    else if (document.layers)        watermarkID.visibility = ""hidden"";"
    Print #1, "  } else {"
    Print #1, "    if (document.getElementById)     watermarkID.style.visibility = ""visible"";"
    Print #1, "    else if (document.all)           watermarkID.style.visibility = ""visible"";"
    Print #1, "    else if (document.layers)        watermarkID.visibility = ""visible"";"
    Print #1, "  }"
    Print #1, ""
    Print #1, "  setTimeout('CalculateWatermarkPos()',10);"
    Print #1, "}"
    Print #1, ""
    Print #1, "function DOMGetElement(o) {"
    Print #1, "  if (document.getElementById)       return document.getElementById(o);"
    Print #1, "  else if (document.all)             return document.all[o];"
    Print #1, "  else if (document.layers)          return document.layers[o];"
    Print #1, "  return null;"
    Print #1, "}"
    Print #1, ""
    Print #1, "function PositionWatermark(watermarkID, xPos, yPos) {"
    Print #1, "  if (document.getElementById)       watermarkID.style.top = yPos;"
    Print #1, "  else if (document.all)             watermarkID.style.top = yPos;"
    Print #1, "  else if (document.layers)          watermarkID.pageY = yPos;"
    Print #1, ""
    Print #1, "  if (document.getElementById)       watermarkID.style.left = xPos;"
    Print #1, "  else if (document.all)             watermarkID.style.left = xPos;"
    Print #1, "  else if (document.layers)          watermarkID.pageX = xPos;"
    Print #1, "}"
    Print #1, ""
    Print #1, "// -->"
    Print #1, "</script>"
    Print #1, ""
    Print #1, "</head>"
    Print #1, ""
    Print #1, "<body bgcolor=""FFFFFF"" style=""font-family: Arial"" onLoad=""CalculateWatermarkPos()"">"
    Print #1, ""
    Print #1, "<p>"
    If CheckIntermediate Then
      Print #1, "  <i>Click on image for full-res version</i><br>"
      Print #1, "  <a href=""" & FullResName(ctr) & """> <img src=""" & ImageName(ctr) & """ width=" & WidthString & " height=" & HeightString & " alt=""" + AltText(ctr) + """ name=""PhotoImage"" onLoad=""ResizeImage()""></a><br>"
    Else
      Print #1, "  <img src=""" & ImageName(ctr) & """ width=" & WidthString & " height=" & HeightString & " alt=""" + AltText(ctr) + """ name=""PhotoImage"" onLoad=""ResizeImage()""><br>"
    End If
    Print #1, AltText(ctr) + "  <br>"
    Print #1, "  <br>"
    Print #1, "  <a href=""" + IndexLink + """>Back To Index</a><br>"
    If ctr = 1 Then
      If NumberImages > 1 Then
        NextHTMLFileName = ImageName(ctr + 1)
        NextHTMLFileName = HTMLPrefix & Left(NextHTMLFileName, Len(NextHTMLFileName) - 3) & "html"
        Print #1, "  &lt;Prev <a href=""" & NextHTMLFileName & """>Next&gt;</a><br>"
      Else
        Print #1, "  &lt;Prev Next&gt;<br>"
      End If
    ElseIf ctr = NumberImages Then
      PreviousHTMLFileName = ImageName(ctr - 1)
      PreviousHTMLFileName = HTMLPrefix & Left(PreviousHTMLFileName, Len(PreviousHTMLFileName) - 3) & "html"
      Print #1, "  <a href=""" & PreviousHTMLFileName & """>&lt;Prev</a> Next&gt;<br>"
    Else
      PreviousHTMLFileName = ImageName(ctr - 1)
      PreviousHTMLFileName = HTMLPrefix & Left(PreviousHTMLFileName, Len(PreviousHTMLFileName) - 3) & "html"
      NextHTMLFileName = ImageName(ctr + 1)
      NextHTMLFileName = HTMLPrefix & Left(NextHTMLFileName, Len(NextHTMLFileName) - 3) & "html"
      Print #1, "  <a href=""" & PreviousHTMLFileName & """>&lt;Prev</a> <a href=""" & NextHTMLFileName & """>Next&gt;</a><br>"
    End If
    Print #1, "</p>"
    Print #1, ""
    Print #1, "<div id=""watermark"" style=""position:absolute;"">"
    Print #1, "  <form name=""formMain"">"
    Print #1, "    <input TYPE=""button"" NAME=""buttonToggle"" Value=""Full Size"" onClick=""Toggle()"" style=""width:120px;"">"
    Print #1, "  </form>"
    Print #1, "</div>"
    Print #1, ""
    Print #1, "</body>"
    Print #1, "</html>"
    
    'Close HTML file
    Close #1
    
    'Get Thumbnail Information
    'AltText = AltText(ctr)
    FullImageName = DirectoryThumbnails + ThumbName(ctr)
    'Extension = Right(FullImageName, 4)
    'FullImageName = Left(FullImageName, Len(FullImageName) - 4) & TextThumbnailSuffix.Text & Extension
    Module1.ReadImageInfo (FullImageName)
    ImageWidth = Module1.Width
    ImageHeight = Module1.Height
    
    'Remove leading space from width & height
    WidthString = Str(ImageWidth)
    WidthString = Right(WidthString, Len(WidthString) - 1)
    HeightString = Str(ImageHeight)
    HeightString = Right(HeightString, Len(HeightString) - 1)

'    ImageName = ImageList(ctr)
'    Extension = Right(ImageName, 4)
'    ImageName = Left(ImageName, Len(ImageName) - 4) & TextThumbnailSuffix.Text & Extension

    HTMLFileName = ImageName(ctr)
    HTMLFileName = HTMLPrefix & Left(HTMLFileName, Len(HTMLFileName) - 3) & "html" 'remove .jpg or appropriate extension

    'OutputTextFile = TextOutputTextName.Text

    'Specify output
    OutputString = IndentString + "<div class=""float"">"
    TextDebug.Text = TextDebug.Text + vbCrLf + OutputString
    OutputString = IndentString + "  <a href=""" + TextGraphicsPath.Text + HTMLFileName + """>"
    TextDebug.Text = TextDebug.Text + vbCrLf + OutputString
    OutputString = IndentString + "  <img src=""" + TextThumbnailPath.Text + ThumbName(ctr) + """ height=" + HeightString + " width=" + WidthString + " border=0 alt=""" + AltText(ctr) + """></a><br>"
    TextDebug.Text = TextDebug.Text + vbCrLf + OutputString
    For ctr2 = 1 To Val(TextCaptionLines.Text)
      OutputString = IndentString + "  " + CaptionText(ctr2, ctr)
      TextDebug.Text = TextDebug.Text + vbCrLf + OutputString
    Next ctr2
    OutputString = IndentString + "</div>"
    TextDebug.Text = TextDebug.Text + vbCrLf + OutputString
    OutputString = ""
    TextDebug.Text = TextDebug.Text + vbCrLf + OutputString
    
  Next ctr
  
  TextDebug.Text = TextDebug.Text + vbCrLf + "End"
  TextDebug.Text = TextDebug.Text + vbCrLf + " Number Images = " + Str(NumberImages)
  'ReadImageInfo (sFileName)
End Sub

Private Sub CommandStartSlideshow_Click()
  'Implements Class1
  'Dim ImageName As String
  
    Dim HTMLFileName As String
  Dim PreviousHTMLFileName As String
  Dim NextHTMLFileName As String
  Dim Extension As String
  Dim DirectoryGraphics As String
  Dim DirectoryThumbnails As String
  Dim TestChar As String
  Dim IndexLink As String
  Dim ctr3 As Integer
  Dim FileList As String
  Dim ContinueProc As Boolean
  Dim NewEntry As Boolean
  Dim ImageName() As String
  Dim ThumbName() As String
  Dim FullResName() As String
  Dim AltText() As String
  Dim CaptionText() As String
  Dim FullImageName As String
  Dim OutputTextFile As String
  Dim PageTitle As String
  Dim TempSuffix As String
  Dim TempFullImageName As String
  Dim IntermediateSuffixLength As Integer

  DirectoryGraphics = TextGraphicsPathInput.Text
  DirectoryThumbnails = TextThumbnailsPathInput.Text
  
  IndexLink = TextIndexLink.Text
  PageTitle = TextPhotoPageTitle.Text
  HTMLPrefix = TextHTMLPrefix.Text

  IndentString = ""
  For ctr = 1 To Val(TextIndentValue.Text)
    IndentString = IndentString + " "
  Next ctr
  
  ContinueProc = True
  NewEntry = False
  FileList = TextFileList.Text
  IntermediateSuffixLength = Len(TextIntermediateSuffix.Text)
  
  ctr3 = 0
  Do Until ContinueProc = False
    ctr3 = ctr3 + 1
    If Left(FileList, 3) = "END" Then
      ContinueProc = False
    Else
      'Look for next entry
      Do Until NewEntry = True
        If Left(FileList, 5) = "image" Then
          NewEntry = True
        Else
          'Remove Current Line
          ctr = 1
          Do Until TestChar = Chr$(13)
            TestChar = Mid(FileList, ctr, 1)
            ctr = ctr + 1
          Loop
          FileList = Right(FileList, Len(FileList) - ctr)
        End If
      Loop
      NewEntry = False
      
      'Get Image Name, Remove Leading Directory, then trim FileList
      ReDim Preserve ImageName(ctr3)
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(FileList, ctr, 1)
        ctr = ctr + 1
      Loop
      ImageName(ctr3) = Mid(FileList, 8, ctr - 10)
      FileList = Right(FileList, Len(FileList) - ctr)

      ReDim Preserve ThumbName(ctr3)
      'Get Thumb Name, then trim FileList
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(FileList, ctr, 1)
        ctr = ctr + 1
      Loop
      ThumbName(ctr3) = Mid(FileList, 8, ctr - 10)
      FileList = Right(FileList, Len(FileList) - ctr)

      ReDim Preserve AltText(ctr3)
      'Get Alt Text, then trim FileList
      ctr = 1
      TestChar = ""
      Do Until TestChar = Chr$(13)
        TestChar = Mid(FileList, ctr, 1)
        ctr = ctr + 1
      Loop
      AltText(ctr3) = Mid(FileList, 6, ctr - 8)
      FileList = Right(FileList, Len(FileList) - ctr)
      
      'Get Caption Text
      ReDim Preserve CaptionText(Val(TextCaptionLines.Text), ctr3)
      For ctr2 = 1 To Val(TextCaptionLines.Text)
            'Get Alt Text, then trim FileList
        ctr = 1
        TestChar = ""
        Do Until TestChar = Chr$(13)
          TestChar = Mid(FileList, ctr, 1)
          ctr = ctr + 1
        Loop
        CaptionText(ctr2, ctr3) = Left(FileList, ctr - 2)
        FileList = Right(FileList, Len(FileList) - ctr)
      Next ctr2
      
      If CheckIntermediate Then
        ReDim Preserve FullResName(ctr3)
        TempSuffix = Right(ImageName(ctr3), 4)
        TempFullImageName = Left(ImageName(ctr3), Len(ImageName(ctr3)) - IntermediateSuffixLength - 4)
        
        FullResName(ctr3) = TempFullImageName + TempSuffix
      End If
      
      'End of Current Revision
    End If
  Loop
      
  NumberImages = ctr3 - 1
  
  For ctr = 1 To NumberImages
    DoEvents
    
    'Get Image Info
    FullImageName = DirectoryGraphics + ImageName(ctr)
    TextCurrentPhoto.Text = ImageName(ctr)
    Module1.ReadImageInfo (FullImageName)
    ImageWidth = Module1.Width
    ImageHeight = Module1.Height
    
    'Remove leading space from width & height
    WidthString = Str(ImageWidth)
    WidthString = Right(WidthString, Len(WidthString) - 1)
    HeightString = Str(ImageHeight)
    HeightString = Right(HeightString, Len(HeightString) - 1)

    OutputString = IndentString + "<option value=""" + TextGraphicsPath.Text + ImageName(ctr) + """>" + AltText(ctr) + "</option>"
    TextDebug.Text = TextDebug.Text + vbCrLf + OutputString
  Next ctr

  TextDebug.Text = TextDebug.Text + vbCrLf + "End"
  TextDebug.Text = TextDebug.Text + vbCrLf + " Number Images = " + Str(NumberImages)

End Sub
Module1: 
Option Explicit

' Only the first X bytes of the file are read into a byte array.
' BUFFERSIZE is X.  A larger number will use more memory and
' be slower.  A smaller number may not be able to decode all
' JPEG files.  Feel free to play with this number.
Private Const BUFFERSIZE As Long = 65535

' image type enum
Public Enum eImageType
    itUNKNOWN = 0
    itGIF = 1
    itJPEG = 2
    itPNG = 3
    itBMP = 4
End Enum

' private member variables
Private m_Width As Long
Private m_Height As Long
Private m_Depth As Byte
Private m_ImageType As eImageType


'
' CImageInfo
'
' Author: David Crowell
' davidc@qtm.net
' http://www.qtm.net/~davidc
'
' Released to the public domain
' use however you wish
'
' CImageInfo will get the image type ,dimensions, and
' color depth from JPG, PNG, BMP, and GIF files.
'
' version date: June 16, 1999
'
' http://www.wotsit.org is a good source of
' file format information.  This code would not have been
' possible without the files I found there.
'

' read-only properties

Public Property Get Width() As Long
    Width = m_Width
End Property

Public Property Get Height() As Long
    Height = m_Height
End Property

Public Property Get Depth() As Byte
    Depth = m_Depth
End Property

Public Property Get ImageType() As eImageType
    ImageType = m_ImageType
End Property

Public Sub ReadImageInfo(sFileName As String)
' This is the sub to call to retrieve information on a file.
    
    ' Byte array buffer to store part of the file
    Dim bBuf(BUFFERSIZE) As Byte
    ' Open file number
    Dim iFN As Integer
    
    ' Set all properties to default values
    m_Width = 0
    m_Height = 0
    m_Depth = 0
    m_ImageType = itUNKNOWN
    
    ' here we will load the first part of a file into a byte
'array the amount of the file stored here depends on
'the BUFFERSIZE constant
    iFN = FreeFile
    Open sFileName For Binary As iFN
    Get #iFN, 1, bBuf()
    Close iFN
    
    If bBuf(0) = 137 And bBuf(1) = 80 And bBuf(2) = 78 Then
    ' this is a PNG file
    
        m_ImageType = itPNG
        
        ' get bit depth
        Select Case bBuf(25)
            Case 0
            ' greyscale
                m_Depth = bBuf(24)
                
            Case 2
            ' RGB encoded
                m_Depth = bBuf(24) * 3
                
            Case 3
            ' Palette based, 8 bpp
                m_Depth = 8
                
            Case 4
            ' greyscale with alpha
                m_Depth = bBuf(24) * 2
                
            Case 6
            ' RGB encoded with alpha
                m_Depth = bBuf(24) * 4
                
            Case Else
            ' This value is outside of it's normal range, so
            'we'll assume
            ' that this is not a valid file
                m_ImageType = itUNKNOWN
                
        End Select
        
        If m_ImageType Then
        ' if the image is valid then
        
            ' get the width
            m_Width = Mult(bBuf(19), bBuf(18))
            
            ' get the height
            m_Height = Mult(bBuf(23), bBuf(22))
        End If
        
    End If
    
    If bBuf(0) = 71 And bBuf(1) = 73 And bBuf(2) = 70 Then
    ' this is a GIF file
        
        m_ImageType = itGIF
        
        ' get the width
        m_Width = Mult(bBuf(6), bBuf(7))
        
        ' get the height
        m_Height = Mult(bBuf(8), bBuf(9))
        
        ' get bit depth
        m_Depth = (bBuf(10) And 7) + 1
    End If
    
    If bBuf(0) = 66 And bBuf(1) = 77 Then
    ' this is a BMP file
    
        m_ImageType = itBMP
        
        ' get the width
        m_Width = Mult(bBuf(18), bBuf(19))
        
        ' get the height
        m_Height = Mult(bBuf(22), bBuf(23))
        
        ' get bit depth
        m_Depth = bBuf(28)
    End If

    If m_ImageType = itUNKNOWN Then
    ' if the file is not one of the above type then
    ' check to see if it is a JPEG file
        Dim lPos As Long
        
        Do
        ' loop through looking for the byte sequence FF,D8,FF
        ' which marks the begining of a JPEG file
        ' lPos will be left at the postion of the start
            If (bBuf(lPos) = &HFF And bBuf(lPos + 1) = &HD8 _
                 And bBuf(lPos + 2) = &HFF) _
                 Or (lPos >= BUFFERSIZE - 10) Then Exit Do
            
            ' move our pointer up
            lPos = lPos + 1
            
        ' and continue
        Loop
        
        lPos = lPos + 2
        If lPos >= BUFFERSIZE - 10 Then Exit Sub
        
        
        Do
' loop through the markers until we find the one
'starting with FF,C0 which is the block containing the
'image information
        
            Do
            ' loop until we find the beginning of the next marker
                If bBuf(lPos) = &HFF And bBuf(lPos + 1) _
               <> &HFF Then Exit Do
                lPos = lPos + 1
                If lPos >= BUFFERSIZE - 10 Then Exit Sub
            Loop
            
            ' move pointer up
            lPos = lPos + 1
            
            Select Case bBuf(lPos)
                Case &HC0 To &HC3, &HC5 To &HC7, &HC9 To &HCB, _
                &HCD To &HCF
                ' we found the right block
                    Exit Do
            End Select
            
            ' otherwise keep looking
            lPos = lPos + Mult(bBuf(lPos + 2), bBuf(lPos + 1))
            
            ' check for end of buffer
            If lPos >= BUFFERSIZE - 10 Then Exit Sub
            
        Loop
        
        ' If we've gotten this far it is a JPEG and we are ready
        ' to grab the information.
        
        m_ImageType = itJPEG
        
        ' get the height
        m_Height = Mult(bBuf(lPos + 5), bBuf(lPos + 4))
        
        ' get the width
        m_Width = Mult(bBuf(lPos + 7), bBuf(lPos + 6))
        
        ' get the color depth
        m_Depth = bBuf(lPos + 8) * 8
        
    End If
    
End Sub
Private Function Mult(lsb As Byte, msb As Byte) As Long
    Mult = lsb + (msb * CLng(256))
End Function