' ------------------------------------------------------------------------------------ ' SimpleContactSheet.vbs ' This script shows how to generate "by hand" a contact sheet in VBScript. ' 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 (MyAlbum 2.1). ' 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 = 704 const CS_Height = 576 const CS_Rows = 3 const CS_Cols = 4 const sCSFileType = ".jpg" const BORDER = 5 ' Border size const hSpacing = 5 ' Horizontal spacing const vSpacing = 5 ' Vertical spacing const backColor = &hc0c0c0 ' Background color of the contact sheet 'const bgPicFile = "M:\Images\Namibia95\Voyage\animal_bgSmall.jpg" ' File used to paint the background const bgPicFile = "c:\winnt\Santa Fe Stucco.bmp" ' File used to paint the background 'const bgPicFile = "M:\Images\Margarita_1996\htmlpics\ocean.jpg" ' File used to paint the background const titleFont = "Times,72,0,700,0,0,0" ' Font used for drawing the title const titleText = "%AN" ' Display String for CS title const pictureFont = "Arial,22,6,400,0,0,0" ' Font used for the picture comment const pictureText = "%C7 - %LE[%C1,5]" ' Display String for the picture comment 'const pictureText = "%FN (%FK KB)" ' Display String for the picture comment const titleColor = &hff0000 ' Color of the title text const pictureColor = &hff0000 ' Color of the picture comment const w3dBorder = 10 ' Width of the thumbnail 3D border (0 for none) const CS_BaseName = "D:\tmpVCD\CS_" ' Path and base name of the generated CS const sTmpPicture = "c:\tmpPicture.bmp" ' Temporary file where are resized the pictures 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 ' 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. dim alb, pic, picCS, tmpPic, i, nbPic, rect, xP, yP, wTh, hTh, wTh2, hTh2, k, xOffset, yOffset, sText, csIndex, hCmt app.ClearTrace set alb = app.GetCurrentAlbum nbPic = alb.nbPicture k = 0 csIndex = 1 for i = 0 to nbPic-1 Set pic = alb.GetPicture(i) if pic.bSelected then if k = 0 then ' Start a new contact sheet set picCS = NewCS xP = BORDER end if sText = alb.ExpandMacro( pic, pictureText ) app.Trace " Processing picture " & pic.sShortFileName & " (" & sText & ")..." xOffset = 0 yOffset = 0 if (pic.lStatus and &hff) <> TYPE_VID then ' Generate a temporay picture that will be pasted on the CS pic.convertAndResize sTmpPicture, TYPE_BMP, wTh, hTh set tmpPic = alb.AddPicture( sTmpPicture ) tmpPic.Copy 0 wTh2 = tmpPic.w hTh2 = tmpPic.h alb.DeletePicture tmpPic set tmpPic = Nothing ' If it's a vertical picture, center it horizontally in its cell if hTh2 > wTh2 then xOffset = round( (wTh - wTh2) / 2 ) else ' Use the thumbnail pic.copy -1 wTh2 = CInt( alb.ExpandMacro( pic, "%Pw" ) ) hTh2 = CInt( alb.ExpandMacro( pic, "%Ph" ) ) set tmpPic = alb.NewPicture( wTh2, hTh2, 24, 0 ) tmpPic.paste 0,0 tmpPic.convertAndResize sTmpPicture, TYPE_BMP, wTh, hTh alb.DeletePicture tmpPic set tmpPic = Nothing set tmpPic = alb.AddPicture( sTmpPicture ) tmpPic.Copy 0 wTh2 = tmpPic.w hTh2 = tmpPic.h alb.DeletePicture tmpPic set tmpPic = Nothing xOffset = round( (wTh - wTh2) / 2 ) end if picCS.Paste xP+xOffset, yP+yOffset if w3dBorder <> 0 and app.Version > "2.0" then Draw3DBorder xP+xOffset, yP, wTh2, hTh2, w3dBorder ' Write a text under the picture set rect = CreateObject("MyAlbum.rect") rect.x = xP 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 rect.y = yP rect.w = wTh rect.h = hTh picCS.drawText CStr(k+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(k+1), rect, numberFont, numberColor, -1, DT_CENTER or DT_VCENTER or DT_NOPREFIX or DT_SINGLELINE 'const numberColor = &hff0000 ' Color of the picture number 'const numberBkColor = &hc0c0c0 ' Color of the picture number round number end if set rect = nothing if (k 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 k = k + 1 if k >= CS_Cols * CS_Rows then ' Must start a new contact sheet SaveCS k = 0 end if end if next if k<>0 then SaveCS alb.redraw app.Trace "Done !!!", -1, TRACE_GREENDOT function NewCS dim newPic, picBG ' Create an empty new picture app.Trace "Building a new contact sheet (" & CS_Width & "x" & CS_Height & ")", -1, TRACE_INFORMATION set newPic = alb.NewPicture( CS_Width, 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 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 ) 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_CALCRECT yP = rect.y + rect.h + vSpacing rect.w = CS_Width rect.h = CS_Height newPic.drawText sText, rect, titleFont, titleColor, -1, DT_TOP or DT_CENTER or DT_NOPREFIX 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 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 end function function SaveCS dim sFileName, kz sFileName = CS_BaseName & alb.ExpandMacro( Nothing, "%AF" ) kz = InStrRev( sFileName, "." ) sFileName = Left( sFileName, kz - 1 ) & "_" if csIndex < 10 then sFileName = sFileName & "0" sFileName = sFileName & csIndex & sCSFileType picCS.copy 0 alb.DeletePicture picCS set picCS = Nothing app.Trace " Saving contact sheet '" & sFileName & "'..." alb.paste sFileName csIndex = csIndex + 1 end function ' Give the thumbnails a 3D look function Draw3DBorder( 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