Use/selection of Outline font for separator page simulation - Script

[Tim2 Shaffer]

Using HP 5Si, HP9050dsn, and HP9050mfp printers

The following is a vbscript file that creates a simulation of a PCL separator page.
I am using a version in a VB application that is running on a server and prints documents
directly from the server. The VB application provides a UserId to this routine to embed
the UserId in the separator page and then prepends this file in front of the document
print-stream.

It works fine except that the UserId is very dark because of it's size. I would prefer to
use an outline font or something else that would not use so much toner.

I have preceded the lines in question with "******************************".

Thanks in advance for any help.
Tim

PS If you know of a more appropriate area for this posting, please let me know.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Option Explicit

Call BannerTest

Sub BannerTest() 'BannerTest
Dim sFName, sPrinter, sPath
sPrinter = "\\Dcpp100\z_HP52$"
sFName = "XXX.pcl"
sPath = GetVbsPath ' Script Path
If CreateBannerPS(sPath, sFName, "TBS2", sPrinter) Then
PrintDoc sPath & sFName, sPrinter
End If
Msgbox "Banner Sheet printed to: " & Replace(Replace(Replace(sPrinter, "z_", ""), "$", ""), "\\", "")
End Sub

'Creates Banner Sheet Print-Stream file
Function CreateBannerPS(ByVal Path, ByVal FName, ByVal UserId, ByVal sPrinter)
Dim fso, ts
Set fso = CreateObject("Scripting.FileSystemObject")
CreateBannerPS = "False"
'On Error Resume Next
Set ts = fso.CreateTextFile(Path & FName, True) 'Overwrites existing file
'If Err.Number = 58 Then Exit Function 'File already exists
'ts.WriteLine " %-12345X@PJL SET PAGEPROTECT=OFF"
ts.WriteLine " %-12345X@PJL ENTER LANGUAGE=PCL" 'Enter PCL language
ts.WriteLine " E" 'Printer Reset
ts.WriteLine " *t600R" 'Resolution - 600 DPI
ts.WriteLine " &u600D" 'Unit-of-Measure - units per inch
ts.WriteLine " *r0F" 'Presentation
ts.WriteLine " &l0o1E" 'Top Margin
ts.WriteLine " &l0S" 'Simplex/Duplex
ts.WriteLine " &l7H" 'Paper Source
ts.WriteLine " &l2a8c1E" 'Top Margin
ts.WriteLine " *p0x0Y" 'Units of Measure
ts.WriteLine " *c0t5760x7704Y" '???
ts.WriteLine " &l1X" 'Number of copies
ts.WriteLine " *b0M" 'Compression mode
ts.WriteLine " (19U (s4099t0b0s10h0P" 'Font Id, Typeface, Stroke weight, style, pitch, spacing
ts.WriteLine " &d@" 'Underline disable
ts.WriteLine " *v0o0T" 'transparency mode, current pattern
ts.WriteLine " *p415Y *p330X============================================================"
ts.Write " (19U" 'Symbol set - Windows ANSI
ts.Write " (s4099T" 'Typeface - Courier (Scalable)
'ts.Write " (s3t" 'Typeface - Courier
'ts.Write " (s16602T" 'Typeface - Arial
'ts.Write " (s-4B" 'Stroke Weight: -4 Extra Light - Does not seem to work
'ts.Write " (s160S" 'Style: 0-Upright, 1-Italic, 32-Outline - Does not seem to work
'ts.Write " (s0.75H" 'Pitch - characters per inch
'ts.Write " (s0P" 'Spacing - 0 for fixed, 1 for proportional
'Ec (0UEc (s0PEc (s10HEc (s12VEc (s0SEc (s3BEc (s3T

'******************************
ts.WriteLine " (0U (s0P (s0.75H (s12V (s0S (s3B (s3T" 'Upright - works
'ts.WriteLine " (0U (s0P (s0.75H (s12V (s1S (s3B (s3T" 'Italic - works
'ts.WriteLine " (0U (s0P (s0.75H (s12V (s32S (s3B (s3T" 'Outline - Does not work 'ts.WriteLine " (0U (s0P (s0.75H (s12V (s24S (s3B (s3T" 'expanded - Does not work
'ts.WriteLine " (0U (s0P (s0.75H (s12V (s160S (s3B (s3T" 'Outline/shadow - Does not work

ts.WriteLine " *p1600Y *p600X" & UserId
ts.WriteLine " (19U (s4099t0b0s10h0P &d@"
ts.WriteLine " *p2200Y *p330XPrint Server: *p1225X" & Replace(Replace(Replace(sPrinter, "z_", ""), "$", ""), "\\", "")
ts.WriteLine " *p2300Y *p330XDate Printed: *p1225X" & MMDDYYYY(Now)
ts.WriteLine " *p2400Y *p330XTime Printed: *p1225X" & HHNNSS(Now)
ts.WriteLine " *p2600Y *p330X============================================================"
ts.Close: Set ts = Nothing: Set fso = Nothing
If Err.Number = 0 Then CreateBannerPS = True
End Function

Function HHNNSS(strIn) 'Formats time in Hh:Nn:Ss AM/PM format
Dim tmpDate
If IsDate(strIn) = False Then
HHNNSS = "Time Err"
Else
tmpDate = CDate(strIn)
HHNNSS = Mdd(Hour(tmpDate)) &":" & Mdd(Minute(tmpDate)) &":" & Mdd(Second(tmpDate))
If Hour(tmpDate) > 12 then
HHNNSS = HHNNSS & " PM"
Else
HHNNSS = HHNNSS & " AM"
End If
End If
End Function

Function MMDDYYYY(strIn) 'Formats Date in MM/DD/YYYY format
Dim tmpDate
If IsDate(strIn) = False Then
MMDDYYYY = "Date Err"
Else
tmpDate = CDate(strIn)
MMDDYYYY = Mdd(Month(tmpDate)) &"/" & Mdd(Day(tmpDate)) &"/" & Right(Year(tmpDate),4)
End If
End Function

Function Mdd(strIn) 'Make Double Digit
If Len(strIn) = 1 Then
Mdd = "0" & strIn
Else
Mdd = strIn
End If
End Function

Sub PrintDoc(sPathFName, sPrinter)
Dim WshShell,sCopy
Set WshShell = CreateObject("WScript.Shell")
sCopy="cmd /C ""copy /b " & sPathFName & " " & sPrinter & Chr(32)
WshShell.Run sCopy,0,False
Set WshShell = Nothing
End Sub

Function GetVbsPath() 'Returns path of Script file
Dim arrayScr, sTmp, i
arrayScr = Split(WScript.ScriptFullName, "\", -1, 1)
For i = 0 to UBound(arrayScr) - 1
sTmp = sTmp & arrayScr(i) & "\"
Next
GetVbsPath = sTmp
End Function