' ------------------------------------------------------------------------------------
'         			StereoContactSheet.vbs
' This script shows how to generate "by hand" a contact sheet in VBScript.
' This version of the script generate stereo 3D contact sheets that can be used with
' the StereoBee applet by Etienne Monneret (part of the AnaBuilder package
' (http://anabuilder.free.fr)).
' It will generate contact sheets from the set of selected pictures.
' Modify the first block of const(ants) to adapt the contact sheets to your needs.
' The contact sheet can have a plain color background or a textured one using a bitmap
' file to tile the background.
' A fading effect can be applied on the edges of the thumbnails.
' Note: this script is constantly using the Clipboard for the temporary pictures, so
'       use of the clipboard should be avoided while the script is running.
' Updated: Each thumbnail can receive a sequence number in the upper-left corner.
' ------------------------------------------------------------------------------------

Option Explicit

' These constants define how the contact sheets will look
const CS_Width =  320
const CS_Height = 240
const CS_Rows = 2
const CS_Cols = 3
const sCSFileType = ".jpg"
const BORDER = 20		' Border size
const hSpacing = 5		' Horizontal spacing
const vSpacing = 5		' Vertical spacing
const backColor = &hc0c0c0	' Background color of the contact sheet
const bgPicFile = "c:\winnt\Santa Fe Stucco.bmp"	' File used to paint the background
const titleFont = "Times,36,0,700,0,0,0"		' Font used for drawing the title
const titleText = "%AN"					' Display String for CS title

const pictureFont = "Arial,12,0,400,0,0,0"		' Font used for the picture comment
const pictureText = "%C7 - %C1"				' Display String for the picture comment
'const pictureText = "%FN (%FK KB)"			' Display String for the picture comment
const titleColor = &h7f0000				' Color of the title text
const pictureColor = &hff0000				' Color of the picture comment
const w3dBorder = 5					' Width of the thumbnail 3D border (0 for none)
'const outputFolder = "M:\Images\3D\Photos\"		' output folder for the gererated files
const outputFolder = "D:\WebPages\3D\Photos2\"
const sCS_Prefix = "3D" '"%AF"
const numberFont = "" ' "Arial,36,0,700,0,0,0"		' Font used for the picture number (set to an empty string to disable numbering)
const numberColor = &h0000ff				' Color of the picture number
const numberBkColor = &hc0c0c0				' Color of the picture number round number
const n3Doffset = 6					' 3D offset for title and navigation arrows
const n3DoffsetTh = 10					' 3D offset for the thumbnails
const n3DoffsetNum = 6					' Additional 3D offset for the thumbnail numbers
const bUsePages = True
const pageField = "Lieu"

' Do not changes these constants!
Const DT_TOP = &H0		' Specifies top-justified text (single line only).
Const DT_LEFT = &H0		' Aligns text flush-left.
Const DT_CENTER = &H1		' Centers text horizontally.
Const DT_RIGHT = &H2		' Aligns text flush-right.
Const DT_VCENTER = &H4		' Specifies vertically centered text (single line only).
Const DT_BOTTOM = &H8		' Specifies bottom-justified text (single line only).
Const DT_SINGLELINE = &H20	' Specifies single line only. Carriage returns and
Const DT_NOPREFIX = &H800	' Turns off processing of prefix characters.
Const DT_CALCRECT = &H400	' Determines the width and height of the rectangle.
Const ForReading = 1, ForWriting = 2


dim alb, pic, picL, picR, picCS, i, iP, nbPic, rect, xP, yP, wTh, hTh, wTh2, hTh2, kPic, xOffset, yOffset, sText, csIndex, hCmt
dim fso, f, sCSFileName, sHTMLFile, sSBL, nHText, sPrevJPSFileName, sLastCSFileName
Dim tabPages(), nbPages, bAddPage, j, tabPageTh(), sLastPageName, nPageNum, sPageIndex, jPage

app.ClearTrace
set alb = app.GetCurrentAlbum
nbPic = alb.nbPicture
App.Trace "Album name is '" & alb.sAlbumTitle & "'" & vbTab & nbPic & " pictures", -1, TRACE_INFORMATION
App.Trace "Pictures selected in this album: " & alb.nbSelectedPicture, -1, TRACE_INFORMATION

sLastPageName = ""
sLastCSFileName = ""
nPageNum = 0
sPageIndex = ""
if bUsePages then FindPages

Set fso = CreateObject("Scripting.FileSystemObject")

  sHTMLFile = outputFolder & "index.html"
  'app.Trace sHTMLFile
  Set f = fso.OpenTextFile( sHTMLFile, ForWriting, True) 
  f.WriteLine "<HTML>" 
  f.WriteLine "<Head>"  
  f.WriteLine " <title>" & alb.sAlbumTitle & "</title>"
  f.WriteLine " <META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=UTF-8"">"
  f.WriteLine " <META NAME=""Generator"" CONTENT=""MyAlbum v" & alb.ExpandMacro(Nothing,"%MV") & """>"
  f.WriteLine " <meta name=""description"" content=""Generated by MyAlbum. http://www.MyAlbumPro.com"">"
  f.WriteLine "</Head>" 
  f.WriteLine "<body background=""../htmlpic/printed-background.jpg"">"
  f.WriteLine "<h1>" & app.ConvertString( alb.sAlbumTitle, 0 ) & "</h1>"
  f.WriteLine "<hr>"
  
  if bUsePages then  
    f.WriteLine "<table>"
    for jPage = 0 to nbPages-1
      sPageIndex = GetPageIndex( jPage+1 )
      sCSFileName = BuildCSFileName( 1, sPageIndex )
      f.WriteLine "<tr><td valign=center><img src=""../htmlpic/greengla.gif""></td>"
      f.WriteLine "<td valign=center><font size=+3>" & tabPages(jPage) & "</font></td><td>&nbsp;&nbsp;&nbsp;&nbsp;</td>"      
      f.WriteLine "<td><applet codebase=""."" code=""StereoBee"" archive=""StereoBee.jar"" width=""50"" height=""30"" VIEWASTEXT>"
      f.WriteLine "<param name=""filename"" value=""" & GetBaseFilename( sCSFileName ) & """>"
      f.WriteLine "<param name=""kindview"" value=""Crossed"">"
      f.WriteLine "<param name=""fullscreen"" value=""on"">"
      f.WriteLine "</applet>"
      f.WriteLine "</td></tr>"
    next  
    f.WriteLine "</table>"
  else
    sCSFileName = BuildCSFileName( 0, "" )
    f.WriteLine "<applet codebase=""."" code=""StereoBee"" archive=""StereoBee.jar"" width=""100"" height=""70"" VIEWASTEXT>"
    f.WriteLine "<param name=""filename"" value=""" & GetBaseFilename( sCSFileName ) & """>"
    f.WriteLine "<param name=""kindview"" value=""Crossed"">"
    f.WriteLine "<param name=""fullscreen"" value=""on"">"
    f.WriteLine "</applet>"
  end if
  
  f.WriteLine "<hr>"
  f.WriteLine "<center><table><tr align=center>"
  f.WriteLine "<td><b>Built with<br><a href=""http://myalbumpro.com"" target=""_blank"">"
  f.WriteLine "<img src=""../htmlpic/MyAlbumS.png"" alt=""MyAlbum""></a><br><i>Simple image cataloger and slideshow.</i></b></td>"
  f.WriteLine "<td>&nbsp;&nbsp;&nbsp;&nbsp;</td>"
  f.WriteLine "<td>This page uses the <b>StereoBee applet</b><br><a href=""http://anabuilder.free.fr"" target=""_blank""><img src=""../htmlpic/AnaBuilder1.gif""></a><br>"
  f.WriteLine "<i>(Part of the AnaBuilder package)</i>"
  f.WriteLine "</td>"
  f.WriteLine "</tr></table>"

  f.WriteLine "</center>"
  f.WriteLine "</BODY>"
  f.WriteLine "</html>"
  f.Close

if bUsePages then
  ' Now process each page
  for jPage = 0 to nbPages-1
    'if nPageNum <> 0 then ClosePageFile nPageNum
    nPageNum = nPageNum + 1
    sLastPageName = tabPages(jPage)

    call StartPageFile( nPageNum, sLastPageName )
    'fi.WriteLine "<h2><img src=""htmlpic/greengla.gif""><a href=""" & s & """ target=""main"">" & sLastPageName & "</a></h2><br>"

    ProcessPage nPageNum, tabPages(jPage)
  next
else
  ProcessPage 0, ""
end if
alb.redraw
app.Trace "Done !!!", -1, TRACE_GREENDOT


'------------------------------------------------------
function StartPageFile( uPageIndex, sPageTitle )
  app.Trace "Generating page #" & uPageIndex & ": " & sPageTitle, 255, TRACE_OK
  sPageIndex = GetPageIndex( uPageIndex )
end function

'------------------------------------------------------
function GetPageIndex( uPageIndex )
  GetPageIndex = CStr(uPageIndex)
  while len(GetPageIndex) < 3
    GetPageIndex = "0" & GetPageIndex
  wend
end function

' ------------------------------------------------------------------------------------
sub ProcessPage( pageNum, pageName )
  kPic = 0
  csIndex = 1
  iP = 0

for i = 0 to nbPic-1
  Set pic = alb.GetPicture(i)
  if pic.bSelected and (pageNum=0 or pic.GetCustomField( pageField ) = pageName) then
    if iP = 0 then
      ' Wait to have a pair of pictures
      set picL = pic
      iP = 1
    else
      set picR = pic
      app.Trace "Processing left picture"  & vbTab & picL.sShortFileName & "...", -1, TRACE_ARROW
      app.Trace "Processing right picture" & vbTab & picR.sShortFileName & "..."
      iP = 0

    if kPic = 0 then
      ' Start a new contact sheet
      set picCS = NewCS
      xP = BORDER
    end if

    ' Text that will be printed under the thumbnails (info taken from left picture)
    sText = alb.ExpandMacro( picL, pictureText )
    'app.Trace "  Processing picture " & pic.sShortFileName & " (" & sText & ")..."
    xOffset = 0
    yOffset = 0
    PastePic2CS picL, picCS, True
    PastePic2CS picR, picCS, False
    
    if (kPic Mod CS_Cols) = CS_Cols-1 then
      ' Start a new row
      xP = BORDER
      yP = yP + hTh + vSpacing + hCmt
    else
      xP = xP + wTh + hSpacing
    end if
    kPic = kPic + 1

    if kPic >= CS_Cols * CS_Rows then
      ' Must start a new contact sheet
      SaveCS picCS, CS_Cols * CS_Rows, True
      kPic = 0
    end if
  end if
  end if
next

if kPic <> 0 then
  SaveCS picCS, kPic, False
end if
end sub

' ------------------------------------------------------------------------------------
function NewCS
  dim newPic, picBG
  ' Create an empty new picture
  app.Trace "Building contact sheet #" & csIndex & " (" & 2*CS_Width & "x" & CS_Height & ")", -1, TRACE_INFORMATION
  sCSFileName = BuildCSFileName( csIndex, sPageIndex )

  set newPic = alb.NewPicture( CS_Width*2, CS_Height, 32, backColor )

  ' if a background image is defined, use it to tile the new picture
  if bgPicFile <> "" then
     set picBG = alb.addPicture( bgPicFile )
     if picBG is nothing then
	app.Trace "  CAUTION: background file '" & bgPicFile & "' cannot be loaded", -1, TRACE_WARNING
     else
	picBG.copy 0
	yP = 0
	do while yP < CS_Height
	  xP = 0
	  do while xP < CS_Width*2
	    newPic.paste xP, yP
	    xP = xP + picBG.w
	  loop
	  yP = yP + picBG.h
        loop
	alb.DeletePicture picBG
	set picBG = Nothing
    end if
  end if

  ' Write album title at the top
  set rect = CreateObject("MyAlbum.rect")
  sText = alb.ExpandMacro( pic, titleText )
  if bUsePages then sText = sLastPageName
  'if bUsePages then sText = sText & " - " & sLastPageName
  rect.x = 0
  rect.y = BORDER
  rect.w = CS_Width
  rect.h = CS_Height
  newPic.drawText sText, rect, titleFont, titleColor, -1, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_SINGLELINE or DT_CALCRECT
  yP = rect.y + rect.h + vSpacing
  nHText = rect.h
  rect.w = CS_Width
  rect.h = CS_Height
  newPic.drawText sText, rect, titleFont, titleColor, -1, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_SINGLELINE

  rect.x = rect.x + CS_Width + n3Doffset
  newPic.drawText sText, rect, titleFont, titleColor, -1, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_SINGLELINE
  set NewCS = newPic

  ' Compute the height of the comment line
  rect.x = 0
  rect.y = BORDER
  rect.w = CS_Width
  rect.h = CS_Height
  newPic.drawText "HHWWjj", rect, pictureFont, pictureColor, -1, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_CALCRECT
  hCmt = rect.h
  set rect = Nothing

  wTh = CInt( (CS_Width  - 2*BORDER + hSpacing) / CS_Cols ) - hSpacing
  hTh = CInt( (CS_Height - 2*BORDER - yP ) / CS_Rows ) - vSpacing - hCmt
  app.Trace "Thumbnails will be " & wTh & "x" & hTh & " pixels", -1, TRACE_INFORMATION
  
  sSBL = ""
end function

' ------------------------------------------------------------------------------------
function SaveCS( byref picCS, nbPics, bNext )
  dim x1, x2, x3, y1, y2, y3, hT, nSp, sOtherCS, bDrawNext, bDrawPrev
  hT = CInt(6*nHText/10)
  nSp = CInt(hT/2)
  bDrawNext = (bNext or (bUsePages and jPage < nbPages-1))
  bDrawPrev = ((csIndex > 1) or (bUsePages and jPage > 0))
  
  if bDrawNext then		' Next arrow
    x1 = CS_Width - nSp - hT
    y1 = nSp
    x2 = CS_Width - nSp
    y2 = nSp + hT / 2
    x3 = x1
    y3 = nSp + hT
    picCS.DrawLine x1, y1, x2, y2, 5, 0, 128
    picCS.DrawLine x2, y2, x3, y3, 5, 0, 128
    picCS.DrawLine x3, y3, x1, y1, 5, 0, 128
    if bNext then
      sOtherCS = BuildCSFileName( csIndex+1, sPageIndex )
    else
      sOtherCS = BuildCSFileName( 1, GetPageIndex( jPage+2 ) )
    end if
    sSBL = sSBL & CInt(x1 + hT/2 + n3Doffset/2) & " " & CInt(y1 + hT/2) & " " & CInt(n3Doffset/2) & " " & hT & " " & hT & " " & GetBaseFilename( sOtherCS ) & vbCRLF
    nbPics = nbPics+1
    x1 = x1 + CS_Width + n3Doffset
    x2 = x2 + CS_Width + n3Doffset
    x3 = x3 + CS_Width + n3Doffset
    picCS.DrawLine x1, y1, x2, y2, 5, 0, 128
    picCS.DrawLine x2, y2, x3, y3, 5, 0, 128
    picCS.DrawLine x3, y3, x1, y1, 5, 0, 128
  end if
  if bDrawPrev then	' Previous arrow
    x1 = nSp + hT
    y1 = nSp
    x2 = x1
    y2 = nSp + hT
    x3 = nSp
    y3 = nSp + hT/2
    picCS.DrawLine x1, y1, x2, y2, 5, 0, 128
    picCS.DrawLine x2, y2, x3, y3, 5, 0, 128
    picCS.DrawLine x3, y3, x1, y1, 5, 0, 128
    sOtherCS = sLastCSFileName 'BuildCSFileName( csIndex-1, sPageIndex )
    sSBL = sSBL & CInt(x1 - hT/2 + n3Doffset/2) & " " & CInt(y1 + hT/2) & " " & CInt(n3Doffset/2) & " " & hT & " " & hT & " " & GetBaseFilename( sOtherCS ) & vbCRLF
    nbPics = nbPics+1
    x1 = x1 + CS_Width + n3Doffset
    x2 = x2 + CS_Width + n3Doffset
    x3 = x3 + CS_Width + n3Doffset
    picCS.DrawLine x1, y1, x2, y2, 5, 0, 128
    picCS.DrawLine x2, y2, x3, y3, 5, 0, 128
    picCS.DrawLine x3, y3, x1, y1, 5, 0, 128
  end if

  picCS.copy 0

  alb.DeletePicture picCS
  set picCS = Nothing

  app.Trace " Saving contact sheet '" & sCSFileName & "'..."
  alb.paste sCSFileName
  sLastCSFileName = sCSFileName

  Set f = fso.OpenTextFile( sCSFileName & ".sbl", ForWriting, True) 
  f.WriteLine nbPics
  f.WriteLine sSBL
  f.Close
  sSBL = ""

  csIndex = csIndex + 1
end function

' ------------------------------------------------------------------------------------
' Give the thumbnails a 3D look
function Draw3DBorder( byref picCS, xP, yP, w, h, wB )
  dim x, y, color, k, step

  step = 1
  for y = yP to yP+wB-1		' Lighten the top border
    k = 1 + (1 / wB) * (wB - step + 1)
'app.trace step & " 1 =" & k
    for x = xP+step-1 to xP+w-1-step+1
      color = picCS.getPixel( x, y )
      picCS.setPixel x, y, lightenPixel( color, k )
    next
    step = step + 1
  next

  step = 1
  for x = xP to xP+wB-1		' Lighten the left border
    k = 1 + (1 / wB) * (wB - step + 1)
'app.trace step & " 2 =" & k
    for y = yP+step to yP+h-step
      color = picCS.getPixel( x, y )
      picCS.setPixel x, y, lightenPixel( color, k )
    next
    step = step + 1
  next

  step = 1
  for y = yP+h-wB+1 to yP+h-1	' Darken the bottom border
    k = 1 + (1 / wB) * step
    for x = xP+wB-step to xP+w-wB+step
      color = picCS.getPixel( x, y )
      picCS.setPixel x, y, darkenPixel( color, k )
    next
    step = step + 1
  next

  step = 1
  for x = xP+w-wB+1 to xP+w-1	' Darken the right border
    k = 1 + (1 / wB) * step
    for y = yP+wB-step to yP+h-1-wB+step
      color = picCS.getPixel( x, y )
      picCS.setPixel x, y, darkenPixel( color, k )
    next
    step = step + 1
  next
end function

' ------------------------------------------------------------------------------------
function lightenPixel( color, factor )
  dim r, g, b
  r = CInt( factor * ( color and &hff ) )
  g = CInt( factor * ( fix( color /   256 ) and &hff ) )
  b = CInt( factor * ( fix( color / 65536 ) and &hff ) )
  if r > 255 then r = 255
  if g > 255 then g = 255
  if b > 255 then b = 255
  lightenPixel = r + g * 256 + b * 65536
end function

' ------------------------------------------------------------------------------------
function darkenPixel( color, factor )
  dim r, g, b
  r = CInt( ( color and &hff ) / factor )
  g = CInt( ( fix( color /   256 ) and &hff ) / factor )
  b = CInt( ( fix( color / 65536 ) and &hff ) / factor )
  darkenPixel = r + g * 256 + b * 65536
end function


' ------------------------------------------------------------------------------------
function PastePic2CS( byref pic, byref picCS, isLeft  )
    dim xo, w0, h0, nbLinks
    xo = -CInt(n3DoffsetTh/2)
    if isLeft then xo = CS_Width + CInt(n3DoffsetTh/2)    
    
    ' When resizing the picture, save the original size to restore it later
    w0 = pic.w
    h0 = pic.h
    pic.Resize wTh, hTh, RM_BOUNDINGRECT, 0, 0
    pic.Copy 0
    wTh2 = pic.w
    hTh2 = pic.h
    'app.Trace wTh & "," & hTh & vbtab  & vbtab & wTh2 & "," & hTh2
    pic.Load False
    pic.w = w0
    pic.h = h0
    
    ' If it's a portrait picture, center it horizontally in its cell
    if wTh2/hTh2 < wTh/hTh then xOffset = round( (wTh - wTh2) / 2 )

    picCS.Paste xP+xOffset+xo, yP+yOffset
    if w3dBorder <> 0 then Draw3DBorder picCS, xP+xOffset+xo, yP, wTh2, hTh2, w3dBorder

    if not isLeft then
      dim sF, iK, sF2, sJPSFile, sPrev, sNext, hLink, sFSBL
      sF = "jps/" & pic.sShortFileName
      iK = InStrRev( sF, "." )
      sJPSFile = left(sF, iK-1) & "_z" & mid(sF,iK)
      sSBL = sSBL & CStr(xP+xOffset + CInt(wTh2/2)) & " " & CStr(yP+yOffset + CInt(hTh2/2)) & " " & CInt(n3DoffsetTh/2) & " " & CStr(wTh2) & " " & CStr(hTh2) &  " " & sJPSFile & vbCRLF

      ' Put links on the pictures to go back to the CS and access previous and next pictures
      nbLinks = 1	' At least go back to contact sheet
      sF = pic.sFileName
'app.Trace "sF=" & sF      
      iK = InStrRev( sF, "\" )
      sF2 = left( sF, iK ) & "jps\" & pic.sShortFileName
      iK = InStrRev( sF2, "." )
      sFSBL = left( sF2, iK-1 ) & "_z" & mid( sF2, iK ) & ".sbl"
      sF2 = "../" & GetBaseFilename( sCSFileName )
'app.trace "sbl=" & sF
      
      sPrev = ""
      sNext = ""
      hLink = nHText
      if kPic > 0 or csIndex > 1 then      ' Not the first, so put a previous link
        sPrev = CStr(CInt(w0/6)) & " " & CStr(CInt(hLink/2)) & " 0 " & CInt(w0/3) & " " & hLink & " " & GetBaseFilename( sPrevJPSFileName )
        nbLinks = nbLinks + 1
      end if
      if true or kPic < CS_Cols * CS_Rows-1 then	' Not the last, so put a next link
        ' Retrieve the name of the next right picture (second next selected picture)
        dim picN, ikS
        set picN = pic
        ikS = 0
        do
          set picN = picN.next
          if picN is Nothing then exit do
          if picN.bSelected  and (not bUsePages or picN.GetCustomField( pageField ) = tabPages(jPage)) then ikS = ikS + 1
        loop while ikS < 2
        if not picN is Nothing and ikS = 2 then
	  sF = picN.sShortFileName
	  iK = InStrRev( sF, "." )
	  sF = left(sF, iK-1) & "_z" & mid(sF,iK)
          sNext = CStr(CInt(5*w0/6)) & " " & CStr(CInt(hLink/2)) & " 0 " & CInt(w0/3) & " " & hLink & " " & sF
          nbLinks = nbLinks + 1
        end if
      end if
'app.Trace "sFSBL = " & sFSBL
      Set f = fso.OpenTextFile( sFSBL, ForWriting, True) 
      f.WriteLine nbLinks
'app.Trace w0 & vbtab & h0
      f.WriteLine CStr(CInt(w0/2)) & " " & CStr(CInt(hLink/2)) & " 0 " & CInt(w0/3) & " " & hLink & " " & sF2
      if sPrev <> "" then f.WriteLine sPrev
      if sNext <> "" then f.WriteLine sNext
      f.Close
      sPrevJPSFileName = sJPSFile
    end if

    ' Write a text under the picture
    set rect = CreateObject("MyAlbum.rect")
    rect.x = xP+xo
    rect.y = yP + hTh2
    rect.w = wTh
    rect.h = hTh
    picCS.drawText sText, rect, pictureFont, pictureColor, -1, DT_TOP or DT_CENTER or DT_NOPREFIX

    ' Draw the picture number on the top-left corner
    if numberFont <> "" then
      rect.x = xP+xo
      rect.y = yP
      rect.w = wTh
      rect.h = hTh
      if isLeft then
        rect.x = rect.x + CInt(n3DoffsetNum/2)
      else
        rect.x = rect.x - CInt(n3DoffsetNum/2)
      end if
      
      picCS.drawText CStr(kPic+1), rect, numberFont, titleColor, -1, DT_TOP or DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_CALCRECT
      if rect.w < rect.h then
	rect.w = rect.h
      else
	rect.h = rect.w
      end if
      if numberBkColor <> -1 then picCS.DrawRectangle rect, 1, numberBkColor, numberBkColor, DRAWRECT_ELLIPSE, 0,0
      ' Now, draw the number in the circle
      picCS.drawText CStr(kPic+1), rect, numberFont, numberColor, -1, DT_CENTER or DT_VCENTER or DT_NOPREFIX or DT_SINGLELINE
    end if
    set rect = nothing
end function


' ------------------------------------------------------------------------------------
function BuildCSFileName( csI, pageIdx )
  'dim kz
  BuildCSFileName = outputFolder & alb.ExpandMacro( Nothing, sCS_Prefix )
  'BuildCSFileName = left( BuildCSFileName, len(BuildCSFileName)-4 )
  if sPageIndex <> "" then BuildCSFileName = BuildCSFileName & "_" & pageIdx
  BuildCSFileName = BuildCSFileName & "_"  
  if csI < 100 then BuildCSFileName = BuildCSFileName & "0"
  if csI < 10  then BuildCSFileName = BuildCSFileName & "0"
  BuildCSFileName = BuildCSFileName & csI
  BuildCSFileName = BuildCSFileName & sCSFileType
  app.Trace "BuildCSFileName = " & BuildCSFileName
end function

' ------------------------------------------------------------------------------------
function GetBaseFilename( byref sFileName )
  dim ii
  ii = InStrRev( sFileName, "\")
  if ii = 0 then ii = InStrRev( sFileName, "/")
  if ii = 0 then
    GetBaseFilename = sFileName
  else
    GetBaseFilename = mid( sFileName, ii+1 )
  end if
end function


' ------------------------------------------------------------------------------------
sub FindPages
dim s

' First find all the pages
nbPages = 0

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 bAddPage = False
      next
      if bAddPage then
        nbPages = nbPages + 1
        redim Preserve tabPages(nbPages)
        tabPages(nbPages-1) = s
      end if
    end if
  end if
next
redim tabPageTh(nbPages)
app.Trace "Found " & nbPages & " pages:"
for j = 0 to nbPages-1
  app.Trace vbTab & tabPages(j)
next
end sub