' ------------------------------------------------------------------------------------
'         			FontSampler.vbs
' This script creates pictures showing a demo text written using the spdified fonts.
' (if anyone knows how to find all the available fonts installed on the computer from
' a script, please let me know!).
' Each picture:
'  - has a grey background
'  - the text is written using style (size, weight,...) specified in the fontStyle constant
'  - its name is built after the name of the font and saved in a PNG file.
' ------------------------------------------------------------------------------------

Option Explicit

' 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_NOCLIP = &H100		' Draws without clipping.
Const DT_CALCRECT = &H400	' Determines the width and height of the rectangle.
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 BORDER = 5
const BIGRECT = 50
const backColor = &hc0c0c0	' Grey background
const textColor = &hff0000	' Blue text
const textBkColor = -1		' Transparent background
const fontStyle = ",72,0,400,0,0,0"
const demoText = "Demo Text"
const fontFolder = "Desktop"
const hMargin = 20

  Dim alb, fso, outputFolder
  app.ClearTrace
  set alb = app.GetCurrentAlbum

  ' Get a temporary file
  Const TemporaryFolder = 2
  Set fso = CreateObject("Scripting.FileSystemObject")
  outputFolder = fso.GetSpecialFolder( TemporaryFolder )
  app.Trace "Pictures will be generated in the following folder:" & outputFolder

  'Dim oShell, f, item
  'set oShell = CreateObject("Shell.Application")
  'set f = oShell.NameSpace( fontFolder )
  'for each item in f.items
  '    app.trace item.name
  'next

  ' Create samples for some fonts...
  CreateFontSample alb, "Arial"
  CreateFontSample alb, "Times"
  CreateFontSample alb, "Verdana"
  CreateFontSample alb, "Comic Sans MS"
  CreateFontSample alb, "Edwardian Script ITC"
  CreateFontSample alb, "Wingdings"
  CreateFontSample alb, "Webdings"

app.Trace "Done!"

Function CreateFontSample( byref alb, byref fontName )
  dim picNew, rect, lSize
  App.Trace "Building sample for font '" & fontName & "'"

  ' Create an empty new picture (arbitrary size)
  set picNew = alb.NewPicture( BIGRECT, BIGRECT, 32, backColor )

  ' Write the picture comment at the bottom of the new picture
  set rect = CreateObject("MyAlbum.rect")
  rect.x = 0
  rect.y = 0
  rect.w = BIGRECT
  rect.h = BIGRECT
  ' Compute the size of the text
  lSize = picNew.drawText( demoText, rect, fontName & fontStyle, textColor, textBkColor, DT_TOP or DT_LEFT or DT_NOPREFIX or DT_CALCRECT )
  app.Trace " Text size for " & fontName & " is " & rect.w & " x " & rect.h

  ' Delete this temporary picture
  alb.DeletePicture picNew
  set picNew = Nothing

  ' Now create a new picture that fits the text size and draw the text
  rect.x = rect.x + hMargin
  set picNew = alb.NewPicture( rect.w+2*hMargin, rect.h, 32, backColor )
  lSize = picNew.drawText( demoText, rect, fontName & fontStyle, textColor, textBkColor, DT_TOP or DT_LEFT or DT_NOPREFIX or DT_NOCLIP )

  ' 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 = outputFolder & "\" & fontName & ".png"
  ' Paste the picture on the clipboard to a new picture and save it
  alb.paste filename

  alb.redraw
End Function