pjl_setmessage

' PJL.bas - set the status message on PJL printers (HP LaserJet etc)
'
' Based on Q154078 at support.microsoft.com which says how to write raw data to the printer
' and plint (a qbasic program)
'
Option Explicit
'
' Structure required by StartDocPrinter
'
Private Type DocInfo
 pDocName As String
 pOutputFile As String
 pDatatype As String
End Type
Dim hPrinter As Long
Dim pjlHeader As String
Dim pjlRdyMsg As String
Dim pjlFooter As String
Private Sub InitEscapeCodes()
' Private function to setup escape codes
pjlHeader = Chr(27) & "%-12345X@PJL" & vbLf
pjlRdyMsg = "@PJL RDYMSG DISPLAY="
pjlFooter = Chr(27) & "%-12345X" & vbLf
End Sub
Public Sub PJL_OpenPrinter(PrinterName As String)
' Call this function before you start sending messages
' Normally set PrinterName to Printer.DeviceName, but you might want to print to the non default printer
Dim MyDoc As DocInfo
If OpenPrinter(PrinterName, hPrinter, 0) = 0 Then MsgBox "Can't print to " & PrinterName: Exit Sub
MyDoc.pDocName = "Document"
MyDoc.pOutputFile = vbNullString
MyDoc.pDatatype = vbNullString
StartDocPrinter hPrinter, 1, MyDoc
Call StartPagePrinter(hPrinter)
InitEscapeCodes
End Sub
Public Sub PJL_ClosePrinter()
' Call this when you have finished writing messages, then they will be spooled
EndPagePrinter hPrinter
EndDocPrinter hPrinter
ClosePrinter hPrinter
hPrinter = Empty
End Sub
Public Sub PJL_WriteMessage(message As String)
' Call this to set a message for the display
' If string is too long for screen it will chop off the end
' If you have two lines on your printer the second line is just a continuation of the first
' If you set it more than once the lines will appear one after the other with 1s delay between them
Dim bDone As Long: Dim pjlCmd As String
If hPrinter = Empty Then MsgBox "Please open the printer first"
pjlCmd = pjlRdyMsg & Chr(34) & message & Chr(34) & vbLf
WritePrinter hPrinter, ByVal pjlHeader, Len(pjlHeader), bDone
WritePrinter hPrinter, ByVal pjlCmd, Len(pjlCmd), bDone
WritePrinter hPrinter, ByVal pjlFooter, Len(pjlFooter), bDone
End Sub