' ------------------------------------------------------------------------------------ ' Create an annotated Title Picture ' This script takes the current picture and generates a new one as Title Page with: ' - a (green) border according number of pixel (0) ' - 3 blocks of text in (blue) color are printed ' - the album title - 1 line of text in the upper half (48) pixel ' - the album copyright info - up to 8 lines of text in the middle (36) pixel ' - an album subComment - 1 line of text in the lower half (28) pixel; options are: ' - the album comment ' - the album creation date ' - the text blocks are separated by a gap of (40) pixel ' - the filename is derived from the original picture with "_tit" appended ' - and will be moved to the first position of the album ' ' - all values in (..) can be adjusted according the personal preferences ' Written by Diedrich Hesmer ' ------------------------------------------------------------------------------------ Option Explicit ' Begin Define the settings for the Title Picture (can be adjusted) const Border = 0 ' Bordersize (pixel) around picture const backColor = &h00ff00 ' Green border background (0x00ff00) const GapTitle = 40 ' Gap between the title text blocks in pixel const fontT ="Arial,48,0,700,0,0,0" ' Title font const fontC ="Arial,37,0,700,0,0,0" ' Copyright font const fontS ="Arial,28,0,700,0,0,0" ' Subcomment font const textColor = &hff0000 ' Blue text (0xff0000) const textShColor = &hc0c0c0 ' LightGray text shadow (0xc0c0c0) 'const textShColor = &h808080 ' DarkGray text shadow (0x808080) const textBkColor = -1 ' Transparent background ' End Define the settings for the Title Picture ' Begin Define Constants that can be used with the DrawText nFormat parameter ' (from Microsoft documentation - don't change them) 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 isequivalent 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. ' End Define Constants that can be used with the DrawText nFormat parameter ' Begin Procedures dim alb, pic, picNew, kPos, rect, CrH, CrY, subComment, cType, k app.ClearTrace set alb = app.GetCurrentAlbum if not alb is nothing then ' Get the current picture and copy it to the cliboard kPos = alb.nCurrentPicture set pic = alb.GetVisiblePicture( kPos ) pic.copy(0) ' Create an empty new picture with a "n" pixel-high space as border around set picNew = alb.NewPicture( pic.w+2*Border, pic.h+2*Border, 32, backColor ) ' Move the new picture just after the original picture alb.MovePicture picNew, kPos, True ' Paste the current picture into the new one leaving a "n" pixel border picNew.paste Border, Border ' Prepare creation of text blocks for the new picture ' Get input for type of SubComment app.Trace " waiting for input" cType = InputBox( "Type {c} or {d} for albumComment or creationDate", "Album SubComment Selection", "") if (cType = "d") or (cType = "D") then ' Write new date app.Trace " CreationDate selected" subComment = alb.dateCreated else app.Trace " AlbumComment selected" subComment = alb.sAlbumComment end if set rect = CreateObject("MyAlbum.rect") ' Write the album Copyright info at the middle of the new picture app.Trace " write text to picture" ' Calculate the size of the text - esp. hight rect.w = pic.w rect.h = pic.h picNew.drawText alb.sAlbumCopyright, rect, fontC, textShColor, textBkColor, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_CALCRECT CrH = rect.h + 3 ' Adjust the rect values rect.x = 1 ' Shift for shadow rect.y = Border + ( 0.5 * pic.h ) - ( 0.5 * CrH ) + 2 rect.w = pic.w picNew.drawText alb.sAlbumCopyright, rect, fontC, textShColor, textBkColor, DT_TOP or DT_CENTER or DT_NOPREFIX rect.x = 0 rect.y = rect.y - 2 CrY = rect.y picNew.drawText alb.sAlbumCopyright, rect, fontC, textColor, textBkColor, DT_TOP or DT_CENTER or DT_NOPREFIX ' Write the album Title at the upper half of the new picture ' Calculate the size of the text - esp. hight rect.h = pic.h picNew.drawText alb.sAlbumTitle, rect, fontT, textShColor, textBkColor, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_CALCRECT ' Adjust the rect values rect.x = 2 ' Shift for shadow rect.y = CrY - rect.h - ( GapTitle + 3 ) + 3 rect.w = pic.w picNew.drawText alb.sAlbumTitle, rect, fontT, textShColor, textBkColor, DT_TOP or DT_CENTER or DT_NOPREFIX rect.x = 0 rect.y = rect.y - 3 picNew.drawText alb.sAlbumTitle, rect, fontT, textColor, textBkColor, DT_TOP or DT_CENTER or DT_NOPREFIX ' Write the album subComment at the lower half of the new picture ' Calculate the size of the text - esp. hight rect.h = pic.h picNew.drawText subComment, rect, fontS, textShColor, textBkColor, DT_TOP or DT_CENTER or DT_NOPREFIX or DT_CALCRECT ' Adjust the rect values rect.x = 1 ' Shift for shadow rect.y = CrY + CrH + ( GapTitle + 3 ) + 1 rect.w = pic.w picNew.drawText subComment, rect, fontS, textShColor, textBkColor, DT_TOP or DT_CENTER or DT_NOPREFIX rect.x = 0 rect.y = rect.y - 1 picNew.drawText subComment, rect, fontS, textColor, textBkColor, DT_TOP or DT_CENTER or DT_NOPREFIX ' Copy the whole picture to the clipboard picNew.copy(0) alb.DeletePicture picNew set picNew = Nothing ' Now create a "real" picture with it's name derived from the original picture name dim filename filename = pic.sFileName k = instrrev( filename, "." ) ' The new picture will have "_tit" appended to its name and will be a JPEG picture filename = left( filename, k-1 ) & "_tit.jpg" ' Paste the picture on the clipboard to a new picture and save it alb.paste filename ' The new picture is at the end of the album, move it as front picture to start alb.MovePicture alb.GetPicture( alb.nbPicture-1 ), 0, True alb.MovePicture alb.GetPicture( 0 ), 1, True ' Set the first Picture as current picture alb.nCurrentPicture = 0 alb.redraw app.Trace " script completed" end if app.StatusBarText = "Script completed"