Showing results for 
Search instead for 
Did you mean: 

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

Tim2 Shaffer
Occasional Contributor

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

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

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.

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"
tmpDate = CDate(strIn)
HHNNSS = Mdd(Hour(tmpDate)) &":" & Mdd(Minute(tmpDate)) &":" & Mdd(Second(tmpDate))
If Hour(tmpDate) > 12 then
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"
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
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) & "\"
GetVbsPath = sTmp
End Function