' ------------------------------------------------------------------------------------ ' Titler3D.vbs ' Use this script to build 3D stereo title pages for your slideshow. ' Build a crossed-view double picture (default is 2XGA 2048x768) and put lines of text ' on it. The resulting picture is added to the current album. ' ' Modify / delete / add "DrawLine" line to draw your own text. ' Syntax : ' DrawLine nLine, sText, sFont, cColor, n3D, nShadow ' with: ' nLine : vertical position in % of the picture height ' sText : text to print (centered by default) ' sFont : specifies the font to use ' cColor : RGB color of the text ' n3D : 3D effect (depth positionning of the text) ' nShadow : offset of the text shadow (0 = no shadow) ' A background picture can also be used to tile the background of the picture: define ' the "bgPicFile" constant with the name of the background picture to use. ' ------------------------------------------------------------------------------------ Option Explicit ' Do not change these constants! ' Constants that can be used with the DrawText nFormat parameter ' (from Microsoft documentation) 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_WORDBREAK = &H10 ' Specifies word-breaking. Const DT_SINGLELINE = &H20 ' Specifies single line only. Carriage returns and ' linefeeds do not break the line. Const DT_EXPANDTABS = &H40 ' Expands tab characters. The default number of characters ' per tab is eight. Const DT_TABSTOP = &H80 ' Sets tab stops. The high-order byte of nFormat is the ' number of characters for each tab. Const DT_NOCLIP = &H100 ' Draws without clipping. Const DT_EXTERNALLEADING = &H200 'Includes the font’s external leading in the line height. ' Normally, external leading is not included in the ' height of a line of text. Const DT_CALCRECT = &H400 ' Determines the width and height of the rectangle. ' If there are multiple lines of text, DrawText will use ' the width of the rectangle pointed to by lpRect and ' extend the base of the rectangle to bound the last line ' of text. If there is only one line of text, DrawText ' will modify the right side of the rectangle so that it ' bounds the last character in the line. In either case, ' DrawText returns the height of the formatted text, but ' does not draw the text. Const DT_NOPREFIX = &H800 ' Turns off processing of prefix characters. Normally, ' DrawText interprets the ampersand (&) mnemonic-prefix ' character as a directive to underscore the character ' that follows, and the two-ampersand (&&) mnemonic-prefix ' characters as a directive to print a single ampersand. ' By specifying DT_NOPREFIX, this processing is turned off. Const DT_INTERNAL = &H1000 ' Uses the system font to calculate text metrics. Const DT_EDITCONTROL = &H2000 ' Duplicates the text-displaying characteristics of a ' multiline edit control. Specifically, the average ' character width is calculated in the same manner as for ' an edit control, and the function does not display a ' partially visible last line. Const DT_PATH_ELLIPSIS = &H4000 ' For displayed text, replaces characters in the middle ' of the string with ellipses so that the result fits in ' the specified rectangle. If the string contains backslash ' (\) characters, DT_PATH_ELLIPSIS preserves as much as ' possible of the text after the last backslash. Const DT_END_ELLIPSIS = &H8000 ' For displayed text, replaces the end of a string with ' ellipses so that the result fits in the specified ' rectangle. Any word (not at the end of the string) that ' goes beyond the limits of the rectangle is truncated ' without ellipses. Const DT_MODIFYSTRING = &H10000 ' Modifies the specified string to match the displayed ' text. This value has no effect unless DT_END_ELLIPSIS ' or DT_PATH_ELLIPSIS is specified. Const DT_RTLREADING = &H20000 ' Layout in right-to-left reading order for bi-directional ' text when the font selected into the hdc is a Hebrew or ' Arabic font. The default reading order for all text is ' left-to-right. Const DT_WORD_ELLIPSIS = &H40000 ' Truncates any word that does not fit in the rectangle ' and adds ellipses. Compare with DT_END_ELLIPSIS and ' DT_PATH_ELLIPSIS. Const DT_NOFULLWIDTHCHARBREAK = &H80000 ' Prevents a line break at a DBCS (double-wide ' character string), so that the line-breaking rule is ' equivalent to SBCS strings. For example, this can be ' used in Korean windows, for more readability of icon ' labels. This value has no effect unless DT_WORDBREAK ' is specified. Const DT_HIDEPREFIX = &H100000 ' Ignores the ampersand (&) prefix character in the text. ' The letter that follows will not be underlined, but ' other mnemonic-prefix characters are still processed. Const DT_PREFIXONLY = &H200000 ' Draws only an underline at the position of the character ' following the ampersand (&) prefix character. Does not ' draw any character in the string. ' Constantes de paramétrage : const maxW = 1024 ' Width of the picture (reesulting picture will be 2x maxW) const maxH = 768 ' Height of the picture const backColor = &h00 ' Background color const BORDER = 5 ' Border width where no text will be written ' Optionnal, name of the background picture used to tile the background const bgPicFile = "c:\winnt\Santa Fe Stucco.bmp" ' Name of the new picture (if left empty, the user is prompted for a new name) const filename = "" dim alb, pic, picNew, i, rect, k, picBG, xP, yP, sNewFile app.ClearTrace set alb = app.GetCurrentAlbum if not alb is nothing then set picNew = alb.NewPicture( 2*maxW, maxH, 24, backColor) set rect = CreateObject("MyAlbum.rect") ' If a background picture us defined, use it to tile the background of the new picture if bgPicFile <> "" then set picBG = alb.addPicture( bgPicFile ) if picBG is nothing then app.Trace " Caution: Unable to load the '" & bgPicFile & "' background picture.", -1, TRACE_WARNING else picBG.copy 0 yP = 0 do while yP < maxH xP = 0 do while xP < 2*maxW picNew.paste xP, yP xP = xP + picBG.w loop yP = yP + picBG.h loop alb.DeletePicture picBG set picBG = Nothing end if end if ' Modify / delete / add the following lines: DrawLine 10, "", "Times,100,0,700,0,0,0", &hAA0C08, 10, 5 DrawLine 30, "", "Times,100,0,700,0,0,0", &hAA0C08, 10, 5 DrawLine 55, "Photos :", "Arial,55,0,700,0,0,0", &h000000, 1, 3 DrawLine 62, "", "Arial,55,0,700,0,0,0", &h000000, 5, 3 DrawLine 75 , "Music :", "Arial,55,0,700,0,0,0", &h01C0C0, 1, 3 DrawLine 82, "", "Arial,55,0,700,0,0,0", &h01C0C0, 5, 3 ' Now save the new picture sNewFile = filename if sNewFile = "" then ' Default name not specified, so prompt the user sNewFile = app.GetFilename( "Enter the name of the new picture", 1, "StereoTitle.jps", "Stereo JPEG (*.jps)|*.jps|JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|TIFF (*.tif)|*.tif||", &h402 ) end if if sNewFile <> "" then app.trace "Saving the picture '" & sNewFile & "'..." picNew.Save sNewFile, True picNew.UpdateThumbnail True end if set rect = Nothing alb.redraw end if app.Trace "Done!", -1, TRACE_GREENDOT '-------------------------------------------------------------------------------------- sub DrawLine( nLine, sText, sFont, cColor, n3D, nShadow ) dim x, y, h h = (maxH - 2*BORDER) / 100 rect.x = BORDER rect.y = (nLine-1) * h + BORDER rect.w = maxW - 2*BORDER rect.h = maxH if nShadow <> 0 then x = rect.x y = rect.y rect.x = rect.x + nShadow rect.y = rect.y + nShadow picNew.drawText sText, rect, sFont, &h606060, -1, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_SINGLELINE rect.x = rect.x + maxW - 5 + n3D picNew.drawText sText, rect, sFont, &h606060, -1, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_SINGLELINE rect.x = x rect.y = y end if picNew.drawText sText, rect, sFont, cColor, -1, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_SINGLELINE rect.x = rect.x + maxW + n3D picNew.drawText sText, rect, sFont, cColor, -1, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_SINGLELINE end sub