' ------------------------------------------------------------------------------------ ' 35mmFilm.vbs ' Builds a fake 35mm film strip by pasting the selected pictures on the strip. ' This script tries to create a realistic looking 35mm film strip with accurate ' dimensions and markings (frame number, film maker name,...). ' If you own a digital camera and are nostalgic of "old" film cameras, this script ' for you! ' ------------------------------------------------------------------------------------ option explicit ' Standard 35mm (ANSI standard PH1.14-1990 - ISO 1007) dimensions ' Perforation size (in mm) const wPerf = 1.98 ' Perforation width const hPerf = 2.80 ' Perforation height const rPerf = 0.50 ' Perforation corner radius const hspPerf = 4.75 ' Spacing between perforations const wBorder = 2.00 ' Border size (edge of the film to perforations) ' Film strip parameters const crBackColor = &h101010 ' Color of the film (sort of dark gray) const crPerfColor = &he0e0e0 ' Color of the perforation hole const sMarking = "FUJI RDP III" '"SLIDE-o-COLOR IV" ' Put your film brand here const crMarking = &hff0ff ' Color of the markings const wspPic = 1.25 ' Spacing between slides (use 1.25mm so 4/3 pictures will occupy 7 perf) const nStartingFrameCounter = 4 ' Frame numbers are starting with this value ' Strip size Const hFilm = 600 ' Use a higher value to have a larger image Const wFilm = 5600 ' Use a higher value to have a longer strip ' Tip: to enhance text quality, build a large picture and resize it afterwards 'Windows constants (do not change!) Const DT_CENTER = &H1 ' Centers text horizontally. Dim alb, picNew, fz, rc, xP, xP0, yP, yP2, rcPic, rcT, iP Dim hFont, wFont, wFont2, sFont, sFont2, hFontT, sFontT, x, y, hPic, wPic, spPic App.ClearTrace set alb = app.GetCurrentAlbum app.Trace "Creating the new picture (" & hFilm & "x" & wFilm & ")...", &hff0000, TRACE_WAIT set picNew = alb.NewPicture( wFilm, hFilm, 32, crBackColor ) fz = hFilm / 35.0 ' Pixels per mm on the new picture app.Trace "Scaling factor fz = " & fz & " pixel/mm" set rc = CreateObject("MyAlbum.rect") set rcT = CreateObject("MyAlbum.rect") set rcPic = CreateObject("MyAlbum.rect") ' Perforations app.Trace "Drawing perforations...", &hff0000, TRACE_WAIT xP = wPerf / 2 * fz xP0 = xP yP = wBorder * fz rc.w = wPerf * fz rc.h = hPerf * fz yP2 = hFilm - yP - rc.h while xP < wFilm rc.x = xP rc.y = yP 'app.Trace rc.x & vbTab & rc.y & vbTab & rc.w & vbTab & rc.h picNew.DrawRectangle rc, 0, crPerfColor, crPerfColor, DRAWRECT_ROUNDRECT, 3*rPerf/2 * fz, 2*rPerf * fz rc.y = yP2 picNew.DrawRectangle rc, 0, crPerfColor, crPerfColor, DRAWRECT_ROUNDRECT, 3*rPerf/2 * fz, 2*rPerf * fz xP = xP + hspPerf * fz wend ' Picture numbers and other markings ' A standard frame is 8 perf. Typically, we have numbering on both borders plus ' an intermediate numbering ("A" number), the film maker, and a small arrow. app.Trace "Writing frame numbers and other markings...", &hff0000, TRACE_WAIT xP = xP0 + rc.w iP = nStartingFrameCounter hFont = round(hFilm / 294 *20) hFontT = round(hFilm / 294 *14) wFont = round(hFilm / 294 *12) wFont2 = round(hFilm / 294 *8) sFont = "Arial," & hFont & "," & wFont & ",700" sFont2 = "Arial," & hFont & "," & wFont2 & ",700" sFontT = "Arial," & hFontT & "," & wFont2 & ",700" while xP < wFilm rcT.x = xP rcT.y = 0 rcT.w = hspPerf * fz rcT.h = wBorder * fz picNew.DrawText iP, rcT, sFont, crMarking, -1, 0 rcT.y = hFilm - rcT.h - 0.25 * fz picNew.DrawText iP, rcT, sFont, crMarking, -1, 0 ' Half frame "A" numbering rcT.x = xP + 4 * hspPerf * fz picNew.DrawText iP & "A", rcT, sFont2, crMarking, -1, 0 y = rcT.y + 0.75 * fz picNew.DrawLine rcT.x- 3*fz, y, rcT.x- 2*fz, y, 2, 0, crMarking picNew.DrawLine rcT.x- 3*fz, y+fz, rcT.x- 2*fz, y+fz, 2, 0, crMarking picNew.DrawLine rcT.x- 3*fz, y-1, rcT.x- 3*fz, y+fz, 2, 0, crMarking picNew.DrawLine rcT.x- 2*fz, y-1, rcT.x-fz/2, y+fz/2+1, 2, 0, crMarking picNew.DrawLine rcT.x- 2*fz, y+fz, rcT.x-fz/2, y+fz/2, 2, 0, crMarking ' Film name rcT.x = xP ' + 4* hspPerf * fz rcT.y = 0 rcT.w = 8* hspPerf * fz picNew.DrawText sMarking, rcT, sFontT, &hff0ff, -1, DT_CENTER xP = xP + 8 * hspPerf * fz iP = iP + 1 wend hPic = 24 * fz ' Picture is 24 mm in height wPic = 0 rcPic.x = 0.5 * fz ' Leave a little space for the first slide rcPic.y = 5.5 * fz ' Slide is at 5.5mm from the border = (35-24)/2 dim nbPic, i, pic nbPic = alb.nbPicture app.Trace "Selected pictures in this album: " & alb.nbSelectedPicture, -1, TRACE_INFORMATION app.Trace "Pasting the pictures on the film strip...", &hff0000, TRACE_WAIT for i = 0 to nbPic-1 Set pic = alb.GetPicture(i) if pic.bSelected then app.trace " Processing " & pic.sShortFileName if rcPic.x > wFilm then app.Trace "Caution: film strip too short for remaining pictures", -1, TRACE_WARNING pic.Load True wPic = round( pic.w / pic.h * hPic ) ' Keep picture aspect ratio 'app.Trace "wPic=" & wPic if pic.Resize( wPic, hPic, RM_STRETCH, 0, 0 ) then pic.Copy 0 pic.Load False picNew.Paste rcPic.x, rcPic.y rcPic.x = round( rcPic.x + wPic + wspPic * fz ) end if end if next set rc = Nothing set rcT = Nothing set rcPic = Nothing set picNew = Nothing alb.redraw app.Trace "Done!!!", &hff0000, TRACE_GREENDOT