Simpler Navigation for Servers and Operating Systems - Please Update Your Bookmarks
Completed: a much simpler Servers and Operating Systems section of the Community. We combined many of the older boards, so you won't have to click through so many levels to get at the information you need. Check the consolidated boards here as many sub-forums are now single boards.
If you have bookmarked forums or discussion boards in Servers and Operating Systems, we suggest you check and update them as needed.
Operating System - Microsoft
cancel
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
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